{"header":{"message":"delete old package files (these changes done by package system)","description":null,"timestamp":"2023-12-23T00:40:42.760948427Z","authors":[{}]},"hash":"YRY3LNWJB2A5JZU3PB6PAMP765F6SSVHLUL6U7SLC74QEXHHQI5QC","authors":[{"login":"jaredj","key":"3qqSdJRv6R3QNQvaGTyRYhLtRiCMVYPYhNJFh8CVy362"}],"deps":{"hashes":[["YRY3LNWJB2A5JZU3PB6PAMP765F6SSVHLUL6U7SLC74QEXHHQI5QC","delete old package files (these changes done by package system)"],["AA",null],["ZU5HLEPB6A3RP3QDKJ743UGAQDIYELZP7QHJPP3FRBXGJNUBDIHAC","add work packages; delete all non-newest-version packages"],["EU4NRBVMDSHLWNJYAI76S77TRQ633XHLXK3XASUUIZGTQZCFRIIAC","add ement, mastodon, caml"],["G6APJZ73EZIJZXNQVPR2DHRLC2TKXBNKAJURT3CFKHP7CYBWMDNQC","add work packages; delete all non-newest-version packages"],["TSHPLAIW6L73G6TPVVZ64TCXNUPA3SBMRTGALNLBAKG6ARHGLJRAC","initial commit: git commit 5e25bf3ff2 plus vc-pijul"],["DM6OTYHCTWITRKU3TLRG3CSJE6UULS333DX5OK4WM3GOZ4IOEVMAC","add outshine, for imposing outline structure on init.el"]],"deps":["ZU5HLEPB6A3RP3QDKJ743UGAQDIYELZP7QHJPP3FRBXGJNUBDIHAC"],"known":["TSHPLAIW6L73G6TPVVZ64TCXNUPA3SBMRTGALNLBAKG6ARHGLJRAC","DM6OTYHCTWITRKU3TLRG3CSJE6UULS333DX5OK4WM3GOZ4IOEVMAC","EU4NRBVMDSHLWNJYAI76S77TRQ633XHLXK3XASUUIZGTQZCFRIIAC","G6APJZ73EZIJZXNQVPR2DHRLC2TKXBNKAJURT3CFKHP7CYBWMDNQC"]},"hunks":[{"FileDel":{"deleted_names":[{"basename":"ement-0.9.2.signed","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":483943,"end":483985},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483985},"to":{"change":3,"start":483787,"end":483787},"introduced_by":3}],"inode":{"change":3,"pos":483787}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":483787},"to":{"change":3,"start":483788,"end":483942},"introduced_by":3}],"inode":{"change":3,"pos":483787}},"content":[{"Del":"Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2023-05-16T05:05:02-0400 using RSA"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-0.9.2","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":483988,"end":484010},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":484010},"to":{"change":3,"start":483987,"end":483987},"introduced_by":3}],"inode":{"change":3,"pos":483987}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":".dir-locals.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2116386,"end":2116424},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2116424},"to":{"change":3,"start":2116212,"end":2116212},"introduced_by":3}],"inode":{"change":3,"pos":2116212}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2116212},"to":{"change":3,"start":2116213,"end":2116385},"introduced_by":3}],"inode":{"change":3,"pos":2116212}},"content":[{"Del":";;; Directory Local Variables\n;;; For more information see (info \"(emacs) Directory Variables\")\n\n((emacs-lisp-mode . ((fill-column . 90)\n\t\t (indent-tabs-mode . nil))))\n"}]}},{"FileDel":{"deleted_names":[{"basename":".elpaignore","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2116175,"end":2116210},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2116210},"to":{"change":3,"start":2116107,"end":2116107},"introduced_by":3}],"inode":{"change":3,"pos":2116107}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2116107},"to":{"change":3,"start":2116108,"end":2116174},"introduced_by":3}],"inode":{"change":3,"pos":2116107}},"content":[{"Del":".github/\nimages/\nLICENSE\nMakefile\nmakem.sh\nNOTES.org\nscreenshots/\n"}]}},{"FileDel":{"deleted_names":[{"basename":".github","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2113782,"end":2113800},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2113800},"to":{"change":3,"start":2113781,"end":2113781},"introduced_by":3}],"inode":{"change":3,"pos":2113781}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"workflows","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2113781},"to":{"change":3,"start":2113803,"end":2113823},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2113823},"to":{"change":3,"start":2113802,"end":2113802},"introduced_by":3}],"inode":{"change":3,"pos":2113802}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"test.yml","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2113802},"to":{"change":3,"start":2116073,"end":2116105},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2116105},"to":{"change":3,"start":2113825,"end":2113825},"introduced_by":3}],"inode":{"change":3,"pos":2113825}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2113825},"to":{"change":3,"start":2113826,"end":2116072},"introduced_by":3}],"inode":{"change":3,"pos":2113825}},"content":[{"Del":"# * test.yml --- Test Emacs packages using makem.sh on GitHub Actions\n\n# URL: https://github.com/alphapapa/makem.sh\n# Version: 0.4.2\n\n# * Commentary:\n\n# Based on Steve Purcell's examples at\n# ,\n# .\n\n# * License:\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\nname: \"CI\"\non:\n pull_request:\n push:\n # Comment out this section to enable testing of all branches.\n branches:\n - master\n\njobs:\n build:\n runs-on: ubuntu-latest\n strategy:\n fail-fast: false\n matrix:\n emacs_version:\n - 26.3\n - 27.1\n - 28.2\n - snapshot\n steps:\n - uses: purcell/setup-emacs@master\n with:\n version: ${{ matrix.emacs_version }}\n\n - uses: actions/checkout@v2\n\n - name: Initialize sandbox\n run: |\n SANDBOX_DIR=$(mktemp -d) || exit 1\n echo \"SANDBOX_DIR=$SANDBOX_DIR\" >> $GITHUB_ENV\n ./makem.sh -vv --sandbox=$SANDBOX_DIR --install-deps --install-linters\n\n # The \"all\" rule is not used, because it treats compilation warnings\n # as failures, so linting and testing are run as separate steps.\n\n - name: Lint\n # NOTE: Uncomment this line to treat lint failures as passing\n # so the job doesn't show failure.\n # continue-on-error: true\n run: ./makem.sh -vv --sandbox=$SANDBOX_DIR lint\n\n - name: Test\n if: always() # Run test even if linting fails.\n run: ./makem.sh -vv --sandbox=$SANDBOX_DIR test\n\n# Local Variables:\n# eval: (outline-minor-mode)\n# End:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"README-elpa","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2113744,"end":2113779},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2113779},"to":{"change":3,"start":2085286,"end":2085286},"introduced_by":3}],"inode":{"change":3,"pos":2085286}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2085286},"to":{"change":3,"start":2085287,"end":2113743},"introduced_by":3}],"inode":{"change":3,"pos":2085286}},"content":[{"Del":"\t\t\t ━━━━━━━━━━\n\t\t\t\tEMENT.EL\n\t\t\t ━━━━━━━━━━\n\n\n[https://elpa.gnu.org/packages/ement.svg]\n\nEment.el is a Matrix client for Emacs. It aims to be simple, fast,\nfeatureful, and reliable.\n\nFeel free to join us in the chat room:\n[https://img.shields.io/matrix/ement.el:matrix.org.svg?label=%23ement.el:matrix.org]\n\n\n[https://elpa.gnu.org/packages/ement.svg]\n\n\n[https://img.shields.io/matrix/ement.el:matrix.org.svg?label=%23ement.el:matrix.org]\n\n\n\n1 Installation\n══════════════\n\n1.1 GNU ELPA\n────────────\n\n Ement.el is published in [GNU ELPA], so it may be installed in Emacs\n with the command `M-x package-install RET ement RET'. This is the\n recommended way to install Ement.el, as it will install the current\n stable release.\n\n\n[GNU ELPA] \n\n\n1.2 GNU Guix\n────────────\n\n Ement.el is also available in [GNU Guix] as `emacs-ement'.\n\n\n[GNU Guix] \n\n\n1.3 Debian\n──────────\n\n Ement.el is also available in Debian as [elpa-ement].\n\n\n[elpa-ement] \n\n\n1.4 Git master\n──────────────\n\n The `master' branch of the Git repository is intended to be usable at\n all times; only minor bugs are expected to be found in it before a new\n stable release is made. To install from this, it is recommended to\n use [quelpa-use-package], like this:\n\n ┌────\n │ ;; Install and load `quelpa-use-package'.\n │ (package-install 'quelpa-use-package)\n │ (require 'quelpa-use-package)\n │ \n │ ;; Install Ement.\n │ (use-package ement\n │ :quelpa (ement :fetcher github :repo \"alphapapa/ement.el\"))\n └────\n\n One might also use systems like [Straight] (which is also used by\n [DOOM]) to install from Git, but the author cannot offer support for\n them.\n\n\n[quelpa-use-package] \n\n[Straight] \n\n[DOOM] \n\n\n1.5 Manual\n──────────\n\n Ement.el is intended to be installed with Emacs's package system,\n which will ensure that the required autoloads are generated, etc. If\n you choose to install it manually, you're on your own.\n\n\n2 Usage\n═══════\n\n • \n • \n • \n\n 1. Call command `ement-connect' to connect. Multiple sessions are\n supported, so you may call the command again to connect to another\n account.\n 2. Wait for initial sync to complete (which can take a few\n moments–initial sync JSON requests can be large).\n 3. Use these commands (room-related commands may be called with\n universal prefix to prompt for the room):\n • `ement-list-rooms' to view the list of joined rooms.\n • `ement-view-room' to view a room's buffer, selected with\n completion.\n • `ement-create-room' to create a new room.\n • `ement-create-space' to create a space.\n • `ement-invite-user' to invite a user to a room.\n • `ement-join-room' to join a room.\n • `ement-leave-room' to leave a room.\n • `ement-forget-room' to forget a room.\n • `ement-tag-room' to toggle a tag on a room (including\n favorite/low-priority status).\n • `ement-list-members' to list members in a room.\n • `ement-send-direct-message' to send a direct message to a user\n (in an existing direct room, or creating a new one\n automatically).\n • `ement-room-edit-message' to edit a message at point.\n • `ement-room-send-file' to send a file.\n • `ement-room-send-image' to send an image.\n • `ement-room-set-topic' to set a room's topic.\n • `ement-room-occur' to search in a room's known events.\n • `ement-room-override-name' to override a room's display name.\n • `ement-ignore-user' to ignore a user (or with interactive prefix,\n un-ignore).\n • `ement-room-set-message-format' to set a room's message format\n buffer-locally.\n • `ement-room-toggle-space' to toggle a room's membership in a\n space (a way to group rooms in Matrix).\n • `ement-directory' to view a room directory.\n • `ement-directory-search' to search a room directory.\n 4. Use these special buffers to see events from multiple rooms (you\n can also reply to messages from these buffers!):\n • See all new events that mention you in the `*Ement Mentions*'\n buffer.\n • See all new events in rooms that have open buffers in the `*Ement\n Notifications*' buffer.\n\n\n2.1 Bindings\n────────────\n\n These bindings are common to all of the following buffer types:\n\n ⁃ Switch to a room buffer: `M-g M-r'\n ⁃ Switch to the room list buffer: `M-g M-l'\n ⁃ Switch to the mentions buffer: `M-g M-m'\n ⁃ Switch to the notifications buffer: `M-g M-n'\n\n\n2.1.1 Room buffers\n╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌\n\n ⁃ Show command menu: `?'\n\n\n\n *Movement*\n\n ⁃ Next event: `TAB'\n ⁃ Previous event: `'\n ⁃ Scroll up and mark read: `SPC'\n ⁃ Scroll down: `S-SPC'\n ⁃ Jump to fully-read marker: `M-SPC'\n ⁃ Load older messages: at top of buffer, scroll contents up\n (i.e. `S-SPC', `M-v' or `mwheel-scroll')\n\n *Switching*\n\n ⁃ List rooms: `M-g M-l'\n ⁃ Switch to other room: `M-g M-r'\n ⁃ Switch to mentions buffer: `M-g M-m'\n ⁃ Switch to notifications buffer: `M-g M-n'\n ⁃ Quit window: `q'\n\n *Messages*\n\n ⁃ Write message: `RET'\n ⁃ Write reply to event at point (when region is active, only quote\n marked text) : `S-RET'\n ⁃ Compose message in buffer: `M-RET' (while writing in minibuffer:\n `C-c ')' (Use command `ement-room-compose-org' to activate Org mode\n in the compose buffer.)\n ⁃ Edit message: `'\n ⁃ Delete message: `C-k'\n ⁃ Send reaction to event at point, or send same reaction at point: `s\n r'\n ⁃ Send emote: `s e'\n ⁃ Send file: `s f'\n ⁃ Send image: `s i'\n ⁃ View event source: `v'\n ⁃ Complete members and rooms at point: `C-M-i' (standard\n `completion-at-point' command). (Type an `@' prefix for a member\n mention, a `#' prefix for a room alias, or a `!' prefix for a room\n ID.)\n\n *Images*\n\n ⁃ Toggle scale of image (between fit-to-window and thumbnail):\n `mouse-1'\n ⁃ Show image in new buffer at full size: `double-mouse-1'\n\n *Users*\n\n ⁃ Send direct message: `u RET'\n ⁃ Invite user: `u i'\n ⁃ Ignore user: `u I'\n\n *Room*\n\n ⁃ Occur search in room: `M-s o'\n ⁃ List members: `r m'\n ⁃ Set topic: `r t'\n ⁃ Set message format: `r f'\n ⁃ Set notification rules: `r n'\n ⁃ Override display name: `r N'\n ⁃ Tag/untag room: `r T'\n\n *Room membership*\n\n ⁃ Create room: `R c'\n ⁃ Join room: `R j'\n ⁃ Leave room: `R l'\n ⁃ Forget room: `R F'\n ⁃ Toggle room's spaces: `R s'\n\n *Other*\n\n ⁃ Sync new messages (not necessary if auto sync is enabled; with\n prefix to force new sync): `g'\n\n\n2.1.2 Room list buffer\n╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌\n\n ⁃ Show buffer of room at point: `RET'\n ⁃ Show buffer of next unread room: `SPC'\n ⁃ Move between room names: `TAB' / `'\n\n ⁃ Kill room's buffer: `k'\n ⁃ Toggle room's membership in a space: `s'\n\n\n2.1.3 Directory buffers\n╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌\n\n ⁃ View/join a room: `RET' / `mouse-1'\n ⁃ Load next batch of rooms: `+'\n\n\n2.1.4 Mentions/notifications buffers\n╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌\n\n ⁃ Move between events: `TAB' / `'\n ⁃ Go to event at point in its room buffer: `RET'\n ⁃ Write reply to event at point (shows the event in its room while\n writing) : `S-RET'\n\n\n2.2 Tips\n────────\n\n ⁃ Desktop notifications are enabled by default for events that mention\n the local user. They can also be shown for all events in rooms with\n open buffers.\n ⁃ Send messages in Org mode format by customizing the option\n `ement-room-send-message-filter' (which enables Org format by\n default), or by calling `ement-room-compose-org' in a compose buffer\n (which enables it for a single message). Then Org-formatted\n messages are automatically converted and sent as HTML-formatted\n messages (with the Org syntax as the plain-text fallback). You can\n send syntax such as:\n • Bold, italic, underline, strikethrough\n • Links\n • Tables\n • Source blocks (including results with `:exports both')\n • Footnotes (okay, that might be pushing it, but you can!)\n • And, generally, anything that Org can export to HTML\n ⁃ Starting in the room list buffer, by pressing `SPC' repeatedly, you\n can cycle through and read all rooms with unread buffers. (If a\n room doesn't have a buffer, it will not be included.)\n ⁃ Room buffers and the room-list buffer can be bookmarked in Emacs,\n i.e. using `C-x r m'. This is especially useful with [Burly]: you\n can arrange an Emacs frame with several room buffers displayed at\n once, use `burly-bookmark-windows' to bookmark the layout, and then\n you can restore that layout and all of the room buffers by opening\n the bookmark, rather than having to manually arrange them every time\n you start Emacs or change the window configuration.\n ⁃ Images and other files can be uploaded to rooms using drag-and-drop.\n ⁃ Mention members by typing a `@' followed by their displayname or\n Matrix ID. (Members' names and rooms' aliases/IDs may be completed\n with `completion-at-point' commands.)\n ⁃ You can customize settings in the `ement' group.\n • *Note:* `setq' should not be used for certain options, because it\n will not call the associated setter function. Users who have an\n aversion to the customization system may experience problems.\n\n\n[Burly] \n\n2.2.1 Displaying symbols and emojis\n╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌\n\n Emacs may not display certain symbols and emojis well by default.\n Based on [this question and answer], you may find that the simplest\n way to fix this is to install an appropriate font, like [Noto Emoji],\n and then use this Elisp code:\n\n ┌────\n │ (setf use-default-font-for-symbols nil)\n │ (set-fontset-font t 'unicode \"Noto Emoji\" nil 'append)\n └────\n\n\n[this question and answer]\n\n\n[Noto Emoji] \n\n\n2.3 Encrypted room support through Pantalaimon\n──────────────────────────────────────────────\n\n Ement.el doesn't support encrypted rooms natively, but it can be used\n transparently with the E2EE-aware reverse proxy daemon [Pantalaimon].\n After configuring it according to its documentation, call\n `ement-connect' with the appropriate hostname and port, like:\n\n ┌────\n │ (ement-connect :uri-prefix \"http://localhost:8009\")\n └────\n\n\n[Pantalaimon] \n\n\n3 Rationale\n═══════════\n\n Why write a new Emacs Matrix client when there is already\n [matrix-client.el], by the same author, no less? A few reasons:\n\n • `matrix-client' uses an older version of the Matrix spec, r0.3.0,\n with a few elements of r0.4.0 grafted in. Bringing it up to date\n with the current version of the spec, r0.6.1, would be more work\n than to begin with the current version. Ement.el targets r0.6.1\n from the beginning.\n • `matrix-client' does not use Matrix's lazy-loading feature (which\n was added to the specification later), so initial sync requests can\n take a long time for the server to process and can be large\n (sometimes tens of megabytes of JSON for the client to process!).\n Ement.el uses lazy-loading, which significantly improves\n performance.\n • `matrix-client' automatically makes buffers for every room a user\n has joined, even if the user doesn't currently want to watch a room.\n Ement.el opens room buffers on-demand, improving performance by not\n having to insert events into buffers for rooms the user isn't\n watching.\n • `matrix-client' was developed without the intention of publishing it\n to, e.g. MELPA or ELPA. It has several dependencies, and its code\n does not always install or compile cleanly due to macro-expansion\n issues (apparently depending on the user's Emacs config). Ement.el\n is designed to have minimal dependencies outside of Emacs (currently\n only one, `plz', which could be imported into the project), and\n every file is linted and compiles cleanly using [makem.sh].\n • `matrix-client' uses EIEIO, probably unnecessarily, since few, if\n any, of the benefits of EIEIO are realized in it. Ement.el uses\n structs instead.\n • `matrix-client' uses bespoke code for inserting messages into\n buffers, which works pretty well, but has a few minor bugs which are\n difficult to track down. Ement.el uses Emacs's built-in (and\n perhaps little-known) `ewoc' library, which makes it much simpler\n and more reliable to insert and update messages in buffers, and\n enables the development of advanced UI features more easily.\n • `matrix-client' was, to a certain extent, designed to imitate other\n messaging apps. The result is, at least when used with the\n `matrix-client-frame' command, fairly pleasing to use, but isn't\n especially \"Emacsy.\" Ement.el is intended to better fit into\n Emacs's paradigms.\n • `matrix-client''s long name makes for long symbol names, which makes\n for tedious, verbose code. `ement' is easy to type and makes for\n concise, readable code.\n • The author has learned much since writing `matrix-client' and hopes\n to write simpler, more readable, more maintainable code in Ement.el.\n It's hoped that this will enable others to contribute more easily.\n\n Note that, while `matrix-client' remains usable, and probably will for\n some time to come, Ement.el has now surpassed it in every way. The\n only reason to choose `matrix-client' instead is if one is using an\n older version of Emacs that isn't supported by Ement.el.\n\n\n[matrix-client.el] \n\n[makem.sh] \n\n\n4 Changelog\n═══════════\n\n4.1 0.9.2\n─────────\n\n *Fixes*\n ⁃ Restore position in room list when refreshing.\n ⁃ Completion in minibuffer.\n\n\n4.2 0.9.1\n─────────\n\n *Fixes*\n ⁃ Error in `ement-room-list' command upon initial sync.\n\n\n4.3 0.9\n───────\n\n *Additions*\n\n ⁃ Option `ement-room-timestamp-header-align' controls how timestamp\n headers are aligned in room buffers.\n ⁃ Option `ement-room-view-hook' runs functions when `ement-room-view'\n is called. (By default, it refreshes the room list buffer.)\n ⁃ In the room list, middle-clicking a room which has a buffer closes\n its buffer.\n ⁃ Basic support for video events. (Thanks to [Arto Jantunen].)\n\n *Changes*\n\n ⁃ Using new option `ement-room-timestamp-header-align', timestamp\n headers default to right-aligned. (With default settings, this\n keeps them near message timestamps and makes for a cleaner\n appearance.)\n\n *Fixes*\n\n ⁃ Recognition of certain MXID or displayname forms in outgoing\n messages when linkifying (aka \"pilling\") them.\n ⁃ Unreadable room avatar images no longer cause errors. (Fixes\n [#147]. Thanks to [@jgarte] for reporting.)\n ⁃ Don't error in `ement-room-list' when no rooms are joined. (Fixes\n [#123]. Thanks to [@Kabouik] and [Omar Antolín Camarena] for\n reporting.)\n ⁃ Enable member/room completion in compose buffers. (Fixes [#115].\n Thanks to Thanks to [Justus Piater] and [Caleb Chase] for\n reporting.)\n\n\n[Arto Jantunen] \n\n[#147] \n\n[@jgarte] \n\n[#123] \n\n[@Kabouik] \n\n[Omar Antolín Camarena] \n\n[#115] \n\n[Justus Piater] \n\n[Caleb Chase] \n\n\n4.4 0.8.3\n─────────\n\n *Fixes*\n\n ⁃ Avoid use of `pcase''s `(map :KEYWORD)' form. (This can cause a\n broken installation on older versions of Emacs that have an older\n version of the `map' library loaded, such as Emacs 27.2 included in\n Debian 11. Since there's no way to force Emacs to actually load the\n version of `map' required by this package before installing it\n (which would naturally happen upon restarting Emacs), we can only\n avoid using such forms while these versions of Emacs are widely\n used.)\n\n\n4.5 0.8.2\n─────────\n\n *Fixes*\n\n ⁃ Deduplicate grouped membership events.\n\n\n4.6 0.8.1\n─────────\n\n Added missing changelog entry (of course).\n\n\n4.7 0.8\n───────\n\n *Additions*\n ⁃ Command `ement-create-space' creates a new space.\n ⁃ Command `ement-room-toggle-space' toggles a room's membership in a\n space (a way to group rooms in Matrix).\n ⁃ Visibility of sections in the room list is saved across sessions.\n ⁃ Command `ement-room-list-kill-buffer' kills a room's buffer from the\n room list.\n ⁃ Set `device_id' and `initial_device_display_name' upon login\n (e.g. `Ement.el: username@hostname'). ([#134]. Thanks to [Arto\n Jantunen] for reporting.)\n\n *Changes*\n\n ⁃ Room-related commands may be called interactively with a universal\n prefix to prompt for the room/session (allowing to send events or\n change settings in rooms other than the current one).\n ⁃ Command `ement-room-list' reuses an existing window showing the room\n list when possible. ([#131]. Thanks to [Jeff Bowman] for\n suggesting.)\n ⁃ Command `ement-tag-room' toggles tags (rather than adding by default\n and removing when called with a prefix).\n ⁃ Default room grouping now groups \"spaced\" rooms separately.\n\n *Fixes*\n\n ⁃ Message format filter works properly when writing replies.\n ⁃ Improve insertion of sender name headers when using the \"Elemental\"\n message format.\n ⁃ Prompts in commands `ement-leave-room' and `ement-forget-room'.\n\n\n[#134] \n\n[Arto Jantunen] \n\n[#131] \n\n[Jeff Bowman] \n\n\n4.8 0.7\n───────\n\n *Additions*\n\n ⁃ Command `ement-room-override-name' sets a local override for a\n room's display name. (Especially helpful for 1:1 rooms and bridged\n rooms. See [MSC3015].)\n\n *Changes*\n\n ⁃ Improve display of room tombstones (displayed at top and bottom of\n buffer, and new room ID is linked to join).\n ⁃ Use descriptive prompts in `ement-leave-room' and\n `ement-forget-room' commands.\n\n *Fixes*\n\n ⁃ Command `ement-view-space' when called from a room buffer. (Thanks\n to [Richard Brežák] for reporting.)\n ⁃ Don't call `display-buffer' when reverting room list buffer. (Fixes\n [#121]. Thanks to [mekeor] for reporting.)\n ⁃ Retry sync for network timeouts. (Accidentally broken in v0.6.)\n\n *Internal*\n\n ⁃ Function `ement-put-account-data' accepts `:room' argument to put on\n a room's account data.\n\n\n[MSC3015]\n\n\n[Richard Brežák] \n\n[#121] \n\n[mekeor] \n\n\n4.9 0.6\n───────\n\n *Additions*\n ⁃ Command `ement-view-space' to view a space's rooms in a directory\n buffer.\n\n *Changes*\n ⁃ Improve `ement-describe-room' command (formatting, bindings).\n\n *Fixes*\n ⁃ Retry sync for HTTP 502 \"Bad Gateway\" errors.\n ⁃ Formatting of unban events.\n ⁃ Update password authentication according to newer Matrix spec.\n (Fixes compatibility with Conduit servers. [#66]. Thanks to\n [Travis Peacock], [Arto Jantunen], and [Stephen D].)\n ⁃ Image scaling issues. (Thanks to [Visuwesh].)\n\n\n[#66] \n\n[Travis Peacock] \n\n[Arto Jantunen] \n\n[Stephen D] \n\n[Visuwesh] \n\n\n4.10 0.5.2\n──────────\n\n *Fixes*\n ⁃ Apply `ement-initial-sync-timeout' properly (important for when the\n homeserver is slow to respond).\n\n\n4.11 0.5.1\n──────────\n\n *Fixes*\n ⁃ Autoload `ement-directory' commands.\n ⁃ Faces in `ement-directory' listings.\n\n\n4.12 0.5\n────────\n\n *Additions*\n ⁃ Present \"joined-and-left\" and \"rejoined-and-left\" membership event\n pairs as such.\n ⁃ Process and show rooms' canonical alias events.\n\n *Changes*\n ⁃ The [taxy.el]-based room list, with programmable, smart grouping, is\n now the default `ement-room-list'. (The old,\n `tabulated-list-mode'-based room list is available as\n `ement-tabulated-room-list'.)\n ⁃ When selecting a room to view with completion, don't offer spaces.\n ⁃ When selecting a room with completion, empty aliases and topics are\n omitted instead of being displayed as nil.\n\n *Fixes*\n ⁃ Use of send-message filter when replying.\n ⁃ Replies may be written in compose buffers.\n\n\n[taxy.el] \n\n\n4.13 0.4.1\n──────────\n\n *Fixes*\n ⁃ Don't show \"curl process interrupted\" message when updating a read\n marker's position again.\n\n\n4.14 0.4\n────────\n\n *Additions*\n ⁃ Option `ement-room-unread-only-counts-notifications', now enabled by\n default, causes rooms' unread status to be determined only by their\n notification counts (which are set by the server and depend on\n rooms' notification settings).\n ⁃ Command `ement-room-set-notification-state' sets a room's\n notification state (imitating Element's user-friendly presets).\n ⁃ Room buffers' Transient menus show the room's notification state\n (imitating Element's user-friendly presets).\n ⁃ Command `ement-set-display-name' sets the user's global displayname.\n ⁃ Command `ement-room-set-display-name' sets the user's displayname in\n a room (which is also now displayed in the room's Transient menu).\n ⁃ Column `Notifications' in the `ement-taxy-room-list' buffer shows\n rooms' notification state.\n ⁃ Option `ement-interrupted-sync-hook' allows customization of how\n sync interruptions are handled. (Now, by default, a warning is\n displayed instead of merely a message.)\n\n *Changes*\n ⁃ When a room's read receipt is updated, the room's buffer is also\n marked as unmodified. (In concert with the new option, this makes\n rooms' unread status more intuitive.)\n\n *Fixes*\n ⁃ Binding of command `ement-forget-room' in room buffers.\n ⁃ Highlighting of `@room' mentions.\n\n\n4.15 0.3.1\n──────────\n\n *Fixes*\n ⁃ Room unread status (when the last event in a room is sent by the\n local user, the room is considered read).\n\n\n4.16 0.3\n────────\n\n *Additions*\n ⁃ Command `ement-directory' shows a server's room directory.\n ⁃ Command `ement-directory-search' searches a server's room directory.\n ⁃ Command `ement-directory-next' fetches the next batch of rooms in a\n directory.\n ⁃ Command `ement-leave-room' accepts a `FORCE-P' argument\n (interactively, with prefix) to leave a room without prompting.\n ⁃ Command `ement-forget-room' accepts a `FORCE-P' argument\n (interactively, with prefix) to also leave the room, and to forget\n it without prompting.\n ⁃ Option `ement-notify-mark-frame-urgent-predicates' marks the frame\n as urgent when (by default) a message mentions the local user or\n \"@room\" and the message's room has an open buffer.\n\n *Changes*\n ⁃ Minor improvements to date/time headers.\n\n *Fixes*\n ⁃ Command `ement-describe-room' for rooms without topics.\n ⁃ Improve insertion of old messages around existing timestamp headers.\n ⁃ Reduce D-Bus notification system check timeout to 2 seconds (from\n the default of 25).\n ⁃ Compatibility with Emacs 27.\n\n\n4.17 0.2.1\n──────────\n\n *Fixes*\n ⁃ Info manual export filename.\n\n\n4.18 0.2\n────────\n\n *Changes*\n ⁃ Read receipts are re-enabled. (They're now implemented with a\n global idle timer rather than `window-scroll-functions', which\n sometimes caused a strange race condition that could cause Emacs to\n become unresponsive or crash.)\n ⁃ When determining whether a room is considered unread, non-message\n events like membership changes, reactions, etc. are ignored. This\n fixes a bug that caused certain rooms that had no message events\n (like some bridged rooms) to appear as unread when they shouldn't\n have. But it's unclear whether this is always preferable (e.g. one\n might want a member leaving a room to cause it to be marked unread),\n so this is classified as a change rather than simply a fix, and more\n improvements may be made to this in the future. (Fixes [#97].\n Thanks to [Julien Roy] for reporting and testing.)\n ⁃ The `ement-taxy-room-list' view no longer automatically refreshes\n the list if the region is active in the buffer. (This allows the\n user to operate on multiple rooms without the contents of the buffer\n changing before completing the process.)\n\n *Fixes*\n ⁃ Links to only rooms (as opposed to links to events in rooms) may be\n activated to join them.\n ⁃ Read receipts mark the last completely visible event (rather than\n one that's only partially displayed).\n ⁃ Prevent error when a room avatar image fails to load.\n\n\n[#97] \n\n[Julien Roy] \n\n\n4.19 0.1.4\n──────────\n\n *Fixed*\n ⁃ Info manual directory headers.\n\n\n4.20 0.1.3\n──────────\n\n *Fixed*\n\n ⁃ Temporarily disable sending of read receipts due to an unusual bug\n that could cause Emacs to become unresponsive. (The feature will be\n re-enabled in a future release.)\n\n\n4.21 0.1.2\n──────────\n\n *Fixed*\n ⁃ Function `ement-room-sync' correctly updates room-list buffers.\n (Thanks to [Visuwesh].)\n ⁃ Only send D-Bus notifications when supported. (Fixes [#83]. Thanks\n to [Tassilo Horn].)\n\n\n[Visuwesh] \n\n[#83] \n\n[Tassilo Horn] \n\n\n4.22 0.1.1\n──────────\n\n *Fixed*\n ⁃ Function `ement-room-scroll-up-mark-read' selects the correct room\n window.\n ⁃ Option `ement-room-list-avatars' defaults to what function\n `display-images-p' returns.\n\n\n4.23 0.1\n────────\n\n After almost two years of development, the first tagged release.\n Submitted to GNU ELPA.\n\n\n5 Development\n═════════════\n\n Bug reports, feature requests, suggestions — /oh my/!\n\n\n5.1 Copyright Assignment\n────────────────────────\n\n Ement.el is published in GNU ELPA and is considered part of GNU Emacs.\n Therefore, cumulative contributions of more than 15 lines of code\n require that the author assign copyright of such contributions to the\n FSF. Authors who are interested in doing so may contact\n [assign@gnu.org] to request the appropriate form.\n\n\n[assign@gnu.org] \n\n\n5.2 Matrix spec in Org format\n─────────────────────────────\n\n An Org-formatted version of the Matrix spec is available in the\n [meta/spec] branch.\n\n\n[meta/spec] \n\n\n6 License\n═════════\n\n GPLv3\n"}]}},{"FileDel":{"deleted_names":[{"basename":"README.org","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2085250,"end":2085284},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2085284},"to":{"change":3,"start":2057224,"end":2057224},"introduced_by":3}],"inode":{"change":3,"pos":2057224}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2057224},"to":{"change":3,"start":2057225,"end":2085249},"introduced_by":3}],"inode":{"change":3,"pos":2057224}},"content":[{"Del":"#+TITLE: Ement.el\n\n#+PROPERTY: LOGGING nil\n\n# Export options.\n#+OPTIONS: broken-links:t *:t\n\n# Info export options.\n#+EXPORT_FILE_NAME: ement.texi\n#+TEXINFO_DIR_CATEGORY: Emacs\n#+TEXINFO_DIR_TITLE: Ement: (ement)\n#+TEXINFO_DIR_DESC: Matrix client for Emacs\n\n# Note: This readme works with the org-make-toc package, which automatically updates the table of contents.\n\n#+HTML:

\n\n# ELPA badge image.\n[[https://elpa.gnu.org/packages/ement.html][https://elpa.gnu.org/packages/ement.svg]]\n\nEment.el is a Matrix client for Emacs. It aims to be simple, fast, featureful, and reliable.\n\nFeel free to join us in the chat room: [[https://matrix.to/#/#ement.el:matrix.org][https://img.shields.io/matrix/ement.el:matrix.org.svg?label=%23ement.el:matrix.org]]\n\n* Contents :noexport:\n:PROPERTIES:\n:TOC: :include siblings\n:END:\n:CONTENTS:\n- [[#installation][Installation]]\n- [[#usage][Usage]]\n - [[#bindings][Bindings]]\n - [[#tips][Tips]]\n - [[#encrypted-room-support-through-pantalaimon][Encrypted room support through Pantalaimon]]\n- [[#rationale][Rationale]]\n- [[#changelog][Changelog]]\n- [[#development][Development]]\n:END:\n\n* Screenshots :noexport:\n:PROPERTIES:\n:ID: d818f690-5f22-4eb0-83e1-4d8ce16c9e5b\n:END:\n\nThe default formatting style resembles IRC clients, with each message being prefixed by the username (which enables powerful Emacs features, like using Occur to show all messages from or mentioning a user). Alternative, built-in styles include an Element-like one with usernames above groups of messages, as well as a classic, no-margins IRC style. Messages may be optionally displayed with unique colors for each user (with customizeable contrast), making it easier to follow conversations. Timestamp headers are optionally displayed where a certain amount of time passes between events, as well as where the date changes.\n\n[[images/ement-for-twim.png]]\n\n/Two rooms shown in side-by-side buffers, showing inline images, reactions, date/time headings, room avatars, and messages colored by user (using the modus-vivendi Emacs theme)./\n\n[[images/emacs-with-fully-read-line.png]]\n\n/#emacs:libera.chat showing colored text from IRC users, replies with quoted parts, messages colored by user, addressed usernames colored by their user color, highlighted mentions, and the fully-read marker line (using the modus-vivendi Emacs theme)./\n\n[[images/screenshot5.png]]\n\n/Four rooms shown at once, with messages colored by user, in the default Emacs theme./\n\n[[images/screenshot2.png]]\n\n/A room at the top in the \"Elemental\" display style, with sender names displayed over groups of messages, and only self-messages in an alternate color. The lower window shows an earlier version of the rooms list./\n\n[[images/reactions.png]]\n\n/Reactions displayed as color emojis (may need [[#displaying-symbols-and-emojis][proper Emacs configuration]])./\n\n* Installation\n:PROPERTIES:\n:TOC: :depth 0\n:END:\n\n** GNU ELPA\n\nEment.el is published in [[http://elpa.gnu.org/][GNU ELPA]], so it may be installed in Emacs with the command ~M-x package-install RET ement RET~. This is the recommended way to install Ement.el, as it will install the current stable release.\n\n** GNU Guix\n\nEment.el is also available in [[https://guix.gnu.org/][GNU Guix]] as ~emacs-ement~.\n\n** Debian\n\nEment.el is also available in Debian as [[https://packages.debian.org/elpa-ement][elpa-ement]].\n\n** Git master\n\nThe ~master~ branch of the Git repository is intended to be usable at all times; only minor bugs are expected to be found in it before a new stable release is made. To install from this, it is recommended to use [[https://github.com/quelpa/quelpa-use-package][quelpa-use-package]], like this:\n\n#+BEGIN_SRC elisp\n ;; Install and load `quelpa-use-package'.\n (package-install 'quelpa-use-package)\n (require 'quelpa-use-package)\n\n ;; Install Ement.\n (use-package ement\n :quelpa (ement :fetcher github :repo \"alphapapa/ement.el\"))\n#+END_SRC\n\nOne might also use systems like [[https://github.com/radian-software/straight.el][Straight]] (which is also used by [[https://github.com/doomemacs/doomemacs][DOOM]]) to install from Git, but the author cannot offer support for them.\n\n** Manual\n\nEment.el is intended to be installed with Emacs's package system, which will ensure that the required autoloads are generated, etc. If you choose to install it manually, you're on your own.\n\n* Usage\n:PROPERTIES:\n:TOC: :include descendants :depth 1\n:END:\n:CONTENTS:\n- [[#bindings][Bindings]]\n- [[#tips][Tips]]\n- [[#encrypted-room-support-through-pantalaimon][Encrypted room support through Pantalaimon]]\n:END:\n\n1. Call command ~ement-connect~ to connect. Multiple sessions are supported, so you may call the command again to connect to another account.\n2. Wait for initial sync to complete (which can take a few moments--initial sync JSON requests can be large).\n3. Use these commands (room-related commands may be called with universal prefix to prompt for the room):\n - ~ement-list-rooms~ to view the list of joined rooms.\n - ~ement-view-room~ to view a room's buffer, selected with completion.\n - ~ement-create-room~ to create a new room.\n - ~ement-create-space~ to create a space.\n - ~ement-invite-user~ to invite a user to a room.\n - ~ement-join-room~ to join a room.\n - ~ement-leave-room~ to leave a room.\n - ~ement-forget-room~ to forget a room.\n - ~ement-tag-room~ to toggle a tag on a room (including favorite/low-priority status).\n - ~ement-list-members~ to list members in a room.\n - ~ement-send-direct-message~ to send a direct message to a user (in an existing direct room, or creating a new one automatically).\n - ~ement-room-edit-message~ to edit a message at point.\n - ~ement-room-send-file~ to send a file.\n - ~ement-room-send-image~ to send an image.\n - ~ement-room-set-topic~ to set a room's topic.\n - ~ement-room-occur~ to search in a room's known events.\n - ~ement-room-override-name~ to override a room's display name.\n - ~ement-ignore-user~ to ignore a user (or with interactive prefix, un-ignore).\n - ~ement-room-set-message-format~ to set a room's message format buffer-locally.\n - ~ement-room-toggle-space~ to toggle a room's membership in a space (a way to group rooms in Matrix).\n - ~ement-directory~ to view a room directory.\n - ~ement-directory-search~ to search a room directory.\n4. Use these special buffers to see events from multiple rooms (you can also reply to messages from these buffers!):\n - See all new events that mention you in the =*Ement Mentions*= buffer.\n - See all new events in rooms that have open buffers in the =*Ement Notifications*= buffer.\n\n** Bindings\n\nThese bindings are common to all of the following buffer types:\n\n+ Switch to a room buffer: ~M-g M-r~\n+ Switch to the room list buffer: ~M-g M-l~\n+ Switch to the mentions buffer: ~M-g M-m~\n+ Switch to the notifications buffer: ~M-g M-n~\n\n*** Room buffers\n\n+ Show command menu: ~?~\n\n[[images/transient.png]]\n\n*Movement*\n\n+ Next event: ~TAB~\n+ Previous event: ~~\n+ Scroll up and mark read: ~SPC~\n+ Scroll down: ~S-SPC~\n+ Jump to fully-read marker: ~M-SPC~\n+ Load older messages: at top of buffer, scroll contents up (i.e. ~S-SPC~, ~M-v~ or ~mwheel-scroll~)\n\n*Switching*\n\n+ List rooms: ~M-g M-l~\n+ Switch to other room: ~M-g M-r~\n+ Switch to mentions buffer: ~M-g M-m~\n+ Switch to notifications buffer: ~M-g M-n~\n+ Quit window: ~q~\n\n*Messages*\n\n+ Write message: ~RET~\n+ Write reply to event at point (when region is active, only quote marked text) : ~S-RET~\n+ Compose message in buffer: ~M-RET~ (while writing in minibuffer: ~C-c ')~ (Use command ~ement-room-compose-org~ to activate Org mode in the compose buffer.)\n+ Edit message: ~~\n+ Delete message: ~C-k~\n+ Send reaction to event at point, or send same reaction at point: ~s r~\n+ Send emote: ~s e~\n+ Send file: ~s f~\n+ Send image: ~s i~\n+ View event source: ~v~\n+ Complete members and rooms at point: ~C-M-i~ (standard ~completion-at-point~ command). (Type an ~@~ prefix for a member mention, a ~#~ prefix for a room alias, or a ~!~ prefix for a room ID.)\n\n*Images*\n\n+ Toggle scale of image (between fit-to-window and thumbnail): ~mouse-1~\n+ Show image in new buffer at full size: ~double-mouse-1~\n\n*Users*\n\n+ Send direct message: ~u RET~\n+ Invite user: ~u i~\n+ Ignore user: ~u I~\n\n*Room*\n\n+ Occur search in room: ~M-s o~\n+ List members: ~r m~\n+ Set topic: ~r t~\n+ Set message format: ~r f~\n+ Set notification rules: ~r n~\n+ Override display name: ~r N~\n+ Tag/untag room: ~r T~\n\n*Room membership*\n\n+ Create room: ~R c~\n+ Join room: ~R j~\n+ Leave room: ~R l~\n+ Forget room: ~R F~\n+ Toggle room's spaces: ~R s~\n\n*Other*\n\n+ Sync new messages (not necessary if auto sync is enabled; with prefix to force new sync): ~g~\n\n*** Room list buffer\n\n+ Show buffer of room at point: ~RET~\n+ Show buffer of next unread room: ~SPC~\n+ Move between room names: ~TAB~ / ~~\n\n+ Kill room's buffer: ~k~\n+ Toggle room's membership in a space: ~s~\n\n*** Directory buffers\n\n+ View/join a room: ~RET~ / ~mouse-1~\n+ Load next batch of rooms: ~+~\n\n*** Mentions/notifications buffers\n\n+ Move between events: ~TAB~ / ~~\n+ Go to event at point in its room buffer: ~RET~\n+ Write reply to event at point (shows the event in its room while writing) : ~S-RET~\n\n** Tips\n\n# TODO: Show sending messages in Org format.\n\n+ Desktop notifications are enabled by default for events that mention the local user. They can also be shown for all events in rooms with open buffers.\n+ Send messages in Org mode format by customizing the option ~ement-room-send-message-filter~ (which enables Org format by default), or by calling ~ement-room-compose-org~ in a compose buffer (which enables it for a single message). Then Org-formatted messages are automatically converted and sent as HTML-formatted messages (with the Org syntax as the plain-text fallback). You can send syntax such as:\n - Bold, italic, underline, strikethrough\n - Links\n - Tables\n - Source blocks (including results with ~:exports both~)\n - Footnotes (okay, that might be pushing it, but you can!)\n - And, generally, anything that Org can export to HTML\n+ Starting in the room list buffer, by pressing ~SPC~ repeatedly, you can cycle through and read all rooms with unread buffers. (If a room doesn't have a buffer, it will not be included.)\n+ Room buffers and the room-list buffer can be bookmarked in Emacs, i.e. using =C-x r m=. This is especially useful with [[https://github.com/alphapapa/burly.el][Burly]]: you can arrange an Emacs frame with several room buffers displayed at once, use =burly-bookmark-windows= to bookmark the layout, and then you can restore that layout and all of the room buffers by opening the bookmark, rather than having to manually arrange them every time you start Emacs or change the window configuration.\n+ Images and other files can be uploaded to rooms using drag-and-drop.\n+ Mention members by typing a ~@~ followed by their displayname or Matrix ID. (Members' names and rooms' aliases/IDs may be completed with ~completion-at-point~ commands.)\n+ You can customize settings in the ~ement~ group.\n - *Note:* ~setq~ should not be used for certain options, because it will not call the associated setter function. Users who have an aversion to the customization system may experience problems.\n\n*** Displaying symbols and emojis\n\nEmacs may not display certain symbols and emojis well by default. Based on [[https://emacs.stackexchange.com/questions/62049/override-the-default-font-for-emoji-characters][this question and answer]], you may find that the simplest way to fix this is to install an appropriate font, like [[https://www.google.com/get/noto/#emoji-zsye][Noto Emoji]], and then use this Elisp code:\n\n#+BEGIN_SRC elisp\n (setf use-default-font-for-symbols nil)\n (set-fontset-font t 'unicode \"Noto Emoji\" nil 'append)\n#+END_SRC\n\n** Encrypted room support through Pantalaimon\n\nEment.el doesn't support encrypted rooms natively, but it can be used transparently with the E2EE-aware reverse proxy daemon [[https://github.com/matrix-org/pantalaimon/][Pantalaimon]]. After configuring it according to its documentation, call ~ement-connect~ with the appropriate hostname and port, like:\n\n#+BEGIN_SRC elisp\n (ement-connect :uri-prefix \"http://localhost:8009\")\n#+END_SRC\n\n* Rationale\n\nWhy write a new Emacs Matrix client when there is already [[https://github.com/alphapapa/matrix-client.el][matrix-client.el]], by the same author, no less? A few reasons:\n\n- ~matrix-client~ uses an older version of the Matrix spec, r0.3.0, with a few elements of r0.4.0 grafted in. Bringing it up to date with the current version of the spec, r0.6.1, would be more work than to begin with the current version. Ement.el targets r0.6.1 from the beginning.\n- ~matrix-client~ does not use Matrix's lazy-loading feature (which was added to the specification later), so initial sync requests can take a long time for the server to process and can be large (sometimes tens of megabytes of JSON for the client to process!). Ement.el uses lazy-loading, which significantly improves performance.\n- ~matrix-client~ automatically makes buffers for every room a user has joined, even if the user doesn't currently want to watch a room. Ement.el opens room buffers on-demand, improving performance by not having to insert events into buffers for rooms the user isn't watching.\n- ~matrix-client~ was developed without the intention of publishing it to, e.g. MELPA or ELPA. It has several dependencies, and its code does not always install or compile cleanly due to macro-expansion issues (apparently depending on the user's Emacs config). Ement.el is designed to have minimal dependencies outside of Emacs (currently only one, ~plz~, which could be imported into the project), and every file is linted and compiles cleanly using [[https://github.com/alphapapa/makem.sh][makem.sh]].\n- ~matrix-client~ uses EIEIO, probably unnecessarily, since few, if any, of the benefits of EIEIO are realized in it. Ement.el uses structs instead.\n- ~matrix-client~ uses bespoke code for inserting messages into buffers, which works pretty well, but has a few minor bugs which are difficult to track down. Ement.el uses Emacs's built-in (and perhaps little-known) ~ewoc~ library, which makes it much simpler and more reliable to insert and update messages in buffers, and enables the development of advanced UI features more easily.\n- ~matrix-client~ was, to a certain extent, designed to imitate other messaging apps. The result is, at least when used with the ~matrix-client-frame~ command, fairly pleasing to use, but isn't especially \"Emacsy.\" Ement.el is intended to better fit into Emacs's paradigms.\n- ~matrix-client~'s long name makes for long symbol names, which makes for tedious, verbose code. ~ement~ is easy to type and makes for concise, readable code.\n- The author has learned much since writing ~matrix-client~ and hopes to write simpler, more readable, more maintainable code in Ement.el. It's hoped that this will enable others to contribute more easily.\n\nNote that, while ~matrix-client~ remains usable, and probably will for some time to come, Ement.el has now surpassed it in every way. The only reason to choose ~matrix-client~ instead is if one is using an older version of Emacs that isn't supported by Ement.el.\n\n* Changelog\n:PROPERTIES:\n:TOC: :depth 0\n:END:\n\n** 0.9.2\n\n*Fixes*\n+ Restore position in room list when refreshing.\n+ Completion in minibuffer.\n\n** 0.9.1\n\n*Fixes*\n+ Error in ~ement-room-list~ command upon initial sync.\n\n** 0.9\n\n*Additions*\n\n+ Option ~ement-room-timestamp-header-align~ controls how timestamp headers are aligned in room buffers.\n+ Option ~ement-room-view-hook~ runs functions when ~ement-room-view~ is called. (By default, it refreshes the room list buffer.)\n+ In the room list, middle-clicking a room which has a buffer closes its buffer.\n+ Basic support for video events. (Thanks to [[https://github.com/viiru-][Arto Jantunen]].)\n\n*Changes*\n\n+ Using new option ~ement-room-timestamp-header-align~, timestamp headers default to right-aligned. (With default settings, this keeps them near message timestamps and makes for a cleaner appearance.)\n\n*Fixes*\n\n+ Recognition of certain MXID or displayname forms in outgoing messages when linkifying (aka \"pilling\") them.\n+ Unreadable room avatar images no longer cause errors. (Fixes [[https://github.com/alphapapa/ement.el/issues/147][#147]]. Thanks to [[https://github.com/jgarte][@jgarte]] for reporting.)\n+ Don't error in ~ement-room-list~ when no rooms are joined. (Fixes [[https://github.com/alphapapa/ement.el/issues/123][#123]]. Thanks to [[https://github.com/Kabouik][@Kabouik]] and [[https://github.com/oantolin][Omar Antolín Camarena]] for reporting.)\n+ Enable member/room completion in compose buffers. (Fixes [[https://github.com/alphapapa/ement.el/issues/115][#115]]. Thanks to Thanks to [[https://github.com/piater][Justus Piater]] and [[https://github.com/chasecaleb][Caleb Chase]] for reporting.)\n\n** 0.8.3\n\n*Fixes*\n\n+ Avoid use of ~pcase~'s ~(map :KEYWORD)~ form. (This can cause a broken installation on older versions of Emacs that have an older version of the ~map~ library loaded, such as Emacs 27.2 included in Debian 11. Since there's no way to force Emacs to actually load the version of ~map~ required by this package before installing it (which would naturally happen upon restarting Emacs), we can only avoid using such forms while these versions of Emacs are widely used.)\n\n** 0.8.2\n\n*Fixes*\n\n+ Deduplicate grouped membership events.\n\n** 0.8.1\n\nAdded missing changelog entry (of course).\n\n** 0.8\n\n*Additions*\n+ Command ~ement-create-space~ creates a new space.\n+ Command ~ement-room-toggle-space~ toggles a room's membership in a space (a way to group rooms in Matrix).\n+ Visibility of sections in the room list is saved across sessions.\n+ Command ~ement-room-list-kill-buffer~ kills a room's buffer from the room list.\n+ Set ~device_id~ and ~initial_device_display_name~ upon login (e.g. =Ement.el: username@hostname=). ([[https://github.com/alphapapa/ement.el/issues/134][#134]]. Thanks to [[https://github.com/viiru-][Arto Jantunen]] for reporting.)\n\n*Changes*\n\n+ Room-related commands may be called interactively with a universal prefix to prompt for the room/session (allowing to send events or change settings in rooms other than the current one).\n+ Command ~ement-room-list~ reuses an existing window showing the room list when possible. ([[https://github.com/alphapapa/ement.el/issues/131][#131]]. Thanks to [[https://github.com/jeffbowman][Jeff Bowman]] for suggesting.)\n+ Command ~ement-tag-room~ toggles tags (rather than adding by default and removing when called with a prefix).\n+ Default room grouping now groups \"spaced\" rooms separately.\n\n*Fixes*\n\n+ Message format filter works properly when writing replies.\n+ Improve insertion of sender name headers when using the \"Elemental\" message format.\n+ Prompts in commands ~ement-leave-room~ and ~ement-forget-room~.\n\n** 0.7\n\n*Additions*\n\n+ Command ~ement-room-override-name~ sets a local override for a room's display name. (Especially helpful for 1:1 rooms and bridged rooms. See [[https://github.com/matrix-org/matrix-spec-proposals/pull/3015#issuecomment-1451017296][MSC3015]].)\n\n*Changes*\n\n+ Improve display of room tombstones (displayed at top and bottom of buffer, and new room ID is linked to join).\n+ Use descriptive prompts in ~ement-leave-room~ and ~ement-forget-room~ commands.\n\n*Fixes*\n\n+ Command ~ement-view-space~ when called from a room buffer. (Thanks to [[https://github.com/MagicRB][Richard Brežák]] for reporting.)\n+ Don't call ~display-buffer~ when reverting room list buffer. (Fixes [[https://github.com/alphapapa/ement.el/issues/121][#121]]. Thanks to [[https://github.com/mekeor][mekeor]] for reporting.)\n+ Retry sync for network timeouts. (Accidentally broken in v0.6.) \n\n*Internal*\n\n+ Function ~ement-put-account-data~ accepts ~:room~ argument to put on a room's account data.\n\n** 0.6\n\n*Additions*\n+ Command ~ement-view-space~ to view a space's rooms in a directory buffer.\n\n*Changes*\n+ Improve ~ement-describe-room~ command (formatting, bindings).\n\n*Fixes*\n+ Retry sync for HTTP 502 \"Bad Gateway\" errors.\n+ Formatting of unban events.\n+ Update password authentication according to newer Matrix spec. (Fixes compatibility with Conduit servers. [[https://github.com/alphapapa/ement.el/issues/66][#66]]. Thanks to [[https://github.com/tpeacock19][Travis Peacock]], [[https://github.com/viiru-][Arto Jantunen]], and [[https://github.com/scd31][Stephen D]].)\n+ Image scaling issues. (Thanks to [[https://github.com/vizs][Visuwesh]].)\n\n** 0.5.2\n\n*Fixes*\n+ Apply ~ement-initial-sync-timeout~ properly (important for when the homeserver is slow to respond).\n\n** 0.5.1\n\n*Fixes*\n+ Autoload ~ement-directory~ commands.\n+ Faces in ~ement-directory~ listings.\n\n** 0.5\n\n*Additions*\n+ Present \"joined-and-left\" and \"rejoined-and-left\" membership event pairs as such.\n+ Process and show rooms' canonical alias events.\n\n*Changes*\n+ The [[https://github.com/alphapapa/taxy.el][taxy.el]]-based room list, with programmable, smart grouping, is now the default ~ement-room-list~. (The old, ~tabulated-list-mode~-based room list is available as ~ement-tabulated-room-list~.)\n+ When selecting a room to view with completion, don't offer spaces.\n+ When selecting a room with completion, empty aliases and topics are omitted instead of being displayed as nil.\n\n*Fixes*\n+ Use of send-message filter when replying.\n+ Replies may be written in compose buffers.\n\n** 0.4.1\n\n*Fixes*\n+ Don't show \"curl process interrupted\" message when updating a read marker's position again.\n\n** 0.4\n\n*Additions*\n+ Option ~ement-room-unread-only-counts-notifications~, now enabled by default, causes rooms' unread status to be determined only by their notification counts (which are set by the server and depend on rooms' notification settings).\n+ Command ~ement-room-set-notification-state~ sets a room's notification state (imitating Element's user-friendly presets).\n+ Room buffers' Transient menus show the room's notification state (imitating Element's user-friendly presets).\n+ Command ~ement-set-display-name~ sets the user's global displayname.\n+ Command ~ement-room-set-display-name~ sets the user's displayname in a room (which is also now displayed in the room's Transient menu).\n+ Column ~Notifications~ in the ~ement-taxy-room-list~ buffer shows rooms' notification state.\n+ Option ~ement-interrupted-sync-hook~ allows customization of how sync interruptions are handled. (Now, by default, a warning is displayed instead of merely a message.)\n\n*Changes*\n+ When a room's read receipt is updated, the room's buffer is also marked as unmodified. (In concert with the new option, this makes rooms' unread status more intuitive.)\n\n*Fixes*\n+ Binding of command ~ement-forget-room~ in room buffers.\n+ Highlighting of ~@room~ mentions.\n\n** 0.3.1\n\n*Fixes*\n+ Room unread status (when the last event in a room is sent by the local user, the room is considered read).\n\n** 0.3\n\n*Additions*\n+ Command ~ement-directory~ shows a server's room directory.\n+ Command ~ement-directory-search~ searches a server's room directory.\n+ Command ~ement-directory-next~ fetches the next batch of rooms in a directory.\n+ Command ~ement-leave-room~ accepts a ~FORCE-P~ argument (interactively, with prefix) to leave a room without prompting.\n+ Command ~ement-forget-room~ accepts a ~FORCE-P~ argument (interactively, with prefix) to also leave the room, and to forget it without prompting.\n+ Option ~ement-notify-mark-frame-urgent-predicates~ marks the frame as urgent when (by default) a message mentions the local user or \"@room\" and the message's room has an open buffer.\n\n*Changes*\n+ Minor improvements to date/time headers.\n\n*Fixes*\n+ Command ~ement-describe-room~ for rooms without topics.\n+ Improve insertion of old messages around existing timestamp headers.\n+ Reduce D-Bus notification system check timeout to 2 seconds (from the default of 25).\n+ Compatibility with Emacs 27.\n\n** 0.2.1\n\n*Fixes*\n+ Info manual export filename.\n\n** 0.2\n\n*Changes*\n+ Read receipts are re-enabled. (They're now implemented with a global idle timer rather than ~window-scroll-functions~, which sometimes caused a strange race condition that could cause Emacs to become unresponsive or crash.)\n+ When determining whether a room is considered unread, non-message events like membership changes, reactions, etc. are ignored. This fixes a bug that caused certain rooms that had no message events (like some bridged rooms) to appear as unread when they shouldn't have. But it's unclear whether this is always preferable (e.g. one might want a member leaving a room to cause it to be marked unread), so this is classified as a change rather than simply a fix, and more improvements may be made to this in the future. (Fixes [[https://github.com/alphapapa/ement.el/issues/97][#97]]. Thanks to [[https://github.com/MrRoy][Julien Roy]] for reporting and testing.)\n+ The ~ement-taxy-room-list~ view no longer automatically refreshes the list if the region is active in the buffer. (This allows the user to operate on multiple rooms without the contents of the buffer changing before completing the process.)\n\n*Fixes*\n+ Links to only rooms (as opposed to links to events in rooms) may be activated to join them.\n+ Read receipts mark the last completely visible event (rather than one that's only partially displayed).\n+ Prevent error when a room avatar image fails to load.\n\n** 0.1.4\n\n*Fixed*\n+ Info manual directory headers.\n\n** 0.1.3\n\n*Fixed*\n# + Read receipt-sending function was called too many times when scrolling.\n# + Send read receipts even when the last receipt is outside the range of retrieved events.\n+ Temporarily disable sending of read receipts due to an unusual bug that could cause Emacs to become unresponsive. (The feature will be re-enabled in a future release.)\n\n** 0.1.2\n\n*Fixed*\n+ Function ~ement-room-sync~ correctly updates room-list buffers. (Thanks to [[https://github.com/vizs][Visuwesh]].)\n+ Only send D-Bus notifications when supported. (Fixes [[https://github.com/alphapapa/ement.el/issues/83][#83]]. Thanks to [[https://github.com/tsdh][Tassilo Horn]].)\n\n** 0.1.1\n\n*Fixed*\n+ Function ~ement-room-scroll-up-mark-read~ selects the correct room window.\n+ Option ~ement-room-list-avatars~ defaults to what function ~display-images-p~ returns.\n\n** 0.1\n\nAfter almost two years of development, the first tagged release. Submitted to GNU ELPA.\n\n* Development\n:PROPERTIES:\n:TOC: :include this :ignore descendants\n:END:\n\nBug reports, feature requests, suggestions — /oh my/!\n\n** Copyright Assignment\n:PROPERTIES:\n:TOC: :ignore (this)\n:END:\n\nEment.el is published in GNU ELPA and is considered part of GNU Emacs. Therefore, cumulative contributions of more than 15 lines of code require that the author assign copyright of such contributions to the FSF. Authors who are interested in doing so may contact [[mailto:assign@gnu.org][assign@gnu.org]] to request the appropriate form.\n\n** Matrix spec in Org format\n:PROPERTIES:\n:TOC: :ignore (this)\n:END:\n\nAn Org-formatted version of the Matrix spec is available in the [[https://github.com/alphapapa/ement.el/tree/meta/spec][meta/spec]] branch.\n\n* License\n:PROPERTIES:\n:TOC: :ignore (this)\n:END:\n\nGPLv3\n\n* COMMENT Config :noexport:\n:PROPERTIES:\n:TOC: :ignore (this descendants)\n:END:\n\n# NOTE: The #+OPTIONS: and other keywords did not take effect when in this section (perhaps due to file size or to changes in Org), so they were moved to the top of the file.\n\n** File-local variables\n\n# Local Variables:\n# eval: (require 'org-make-toc)\n# before-save-hook: org-make-toc\n# org-export-with-properties: ()\n# org-export-with-title: t\n# End:\n\n"}]}},{"FileDel":{"deleted_names":[{"basename":"dir","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2057195,"end":2057222},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2057222},"to":{"change":3,"start":2056588,"end":2056588},"introduced_by":3}],"inode":{"change":3,"pos":2056588}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2056588},"to":{"change":3,"start":2056589,"end":2057194},"introduced_by":3}],"inode":{"change":3,"pos":2056588}},"content":[{"Del":"This is the file .../info/dir, which contains the\ntopmost node of the Info hierarchy, called (dir)Top.\nThe first time you invoke Info you start off looking at this node.\n\u001f\nFile: dir,\tNode: Top\tThis is the top of the INFO tree\n\n This (the Directory node) gives a menu of major topics.\n Typing \"q\" exits, \"H\" lists all Info commands, \"d\" returns here,\n \"h\" gives a primer for first-timers,\n \"mEmacs\" visits the Emacs manual, etc.\n\n In Emacs, you can click mouse button 2 on a menu item or cross reference\n to select it.\n\n* Menu:\n\nEmacs\n* Ement: (ement). Matrix client for Emacs.\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-api.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2056550,"end":2056586},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2056586},"to":{"change":3,"start":2050662,"end":2050662},"introduced_by":3}],"inode":{"change":3,"pos":2050662}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2050662},"to":{"change":3,"start":2050663,"end":2056549},"introduced_by":3}],"inode":{"change":3,"pos":2050662}},"content":[{"Del":";;; ement-api.el --- Matrix API library -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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;;;; Debugging\n\n;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable\n;; `ement-debug' messages. This is commented out by default because, even though the\n;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if\n;; that is so at expansion time, the expanded macro calls format the message and check the\n;; log level at runtime, which is not zero-cost.\n\n;; (eval-and-compile\n;; (setq-local warning-minimum-log-level nil)\n;; (setq-local warning-minimum-log-level :debug))\n\n;;;; Requirements\n\n(require 'json)\n(require 'url-parse)\n(require 'url-util)\n\n(require 'plz)\n\n(require 'ement-macros)\n(require 'ement-structs)\n\n;;;; Variables\n\n\n;;;; Customization\n\n\n;;;; Commands\n\n\n;;;; Functions\n\n(cl-defun ement-api (session endpoint\n &key then data params queue\n (content-type \"application/json\")\n (data-type 'text)\n (else #'ement-api-error) (method 'get)\n ;; FIXME: What's the right term for the URL part after \"/_matrix/\"?\n (endpoint-category \"client\")\n (json-read-fn #'json-read)\n ;; NOTE: Hard to say what the default timeouts\n ;; should be. Sometimes the matrix.org homeserver\n ;; can get slow and respond a minute or two later.\n (connect-timeout 10) (timeout 60)\n (version \"r0\"))\n \"Make API request on SESSION to ENDPOINT.\nThe request automatically uses SESSION's server, URI prefix, and\naccess token.\n\nThese keyword arguments are passed to `plz', which see: THEN,\nDATA (passed as BODY), QUEUE (passed to `plz-queue', which see),\nDATA-TYPE (passed as BODY-TYPE), ELSE, METHOD,\nJSON-READ-FN (passed as AS), CONNECT-TIMEOUT, TIMEOUT.\n\nOther arguments include PARAMS (used as the URL's query\nparameters), ENDPOINT-CATEGORY (added to the endpoint URL), and\nVERSION (added to the endpoint URL).\n\nNote that most Matrix requests expect JSON-encoded data, so\nusually the DATA argument should be passed through\n`json-encode'.\"\n (declare (indent defun))\n (pcase-let* (((cl-struct ement-session server token) session)\n ((cl-struct ement-server uri-prefix) server)\n ((cl-struct url type host portspec) (url-generic-parse-url uri-prefix))\n (path (format \"/_matrix/%s/%s/%s\" endpoint-category version endpoint))\n (query (url-build-query-string params))\n (filename (concat path \"?\" query))\n (url (url-recreate-url\n (url-parse-make-urlobj type nil nil host portspec filename nil data t)))\n (headers (ement-alist \"Content-Type\" content-type))\n (plz-args))\n (when token\n ;; Almost every request will require a token (only a few, like checking login flows, don't),\n ;; so we simplify the API by using the token automatically when the session has one.\n (push (cons \"Authorization\" (concat \"Bearer \" token)) headers))\n (setf plz-args (list method url :headers headers :body data :body-type data-type\n :as json-read-fn :then then :else else\n :connect-timeout connect-timeout :timeout timeout :noquery t))\n ;; Omit `then' from debugging because if it's a partially applied\n ;; function on the session object, which may be very large, it\n ;; will take a very long time to print into the warnings buffer.\n ;; (ement-debug (current-time) method url headers)\n (if queue\n (plz-run\n (apply #'plz-queue queue plz-args))\n (apply #'plz plz-args))))\n\n(define-error 'ement-api-error \"Ement API error\" 'error)\n\n(defun ement-api-error (plz-error)\n \"Signal an Ement API error for PLZ-ERROR.\"\n ;; This feels a little messy, but it seems to be reasonable.\n (pcase-let* (((cl-struct plz-error response\n (message plz-message) (curl-error `(,curl-exit-code . ,curl-message)))\n plz-error)\n (status (when (plz-response-p response)\n (plz-response-status response)))\n (body (when (plz-response-p response)\n (plz-response-body response)))\n (json-object (when body\n (ignore-errors\n (json-read-from-string body))))\n (error-message (format \"%S: %s\"\n (or curl-exit-code status)\n (or (when json-object\n (alist-get 'error json-object))\n curl-message\n plz-message))))\n\n (signal 'ement-api-error (list error-message))))\n\n;;;; Footer\n\n(provide 'ement-api)\n\n;;; ement-api.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-autoloads.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2050618,"end":2050660},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2050660},"to":{"change":3,"start":2045696,"end":2045696},"introduced_by":3}],"inode":{"change":3,"pos":2045696}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2045696},"to":{"change":3,"start":2045697,"end":2050617},"introduced_by":3}],"inode":{"change":3,"pos":2045696}},"content":[{"Del":";;; ement-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-\n;;\n;;; Code:\n\n(add-to-list 'load-path (directory-file-name\n (or (file-name-directory #$) (car load-path))))\n\n\f\n;;;### (autoloads nil \"ement\" \"ement.el\" (0 0 0 0))\n;;; Generated autoloads from ement.el\n\n(autoload 'ement-connect \"ement\" \"\\\nConnect to Matrix with USER-ID and PASSWORD, or using SESSION.\nInteractively, with prefix, ignore a saved session and log in\nagain; otherwise, use a saved session if `ement-save-sessions' is\nenabled and a saved session is available, or prompt to log in if\nnot enabled or available.\n\nIf USERID or PASSWORD are not specified, the user will be\nprompted for them.\n\nIf URI-PREFIX is specified, it should be the prefix of the\nserver's API URI, including protocol, hostname, and optionally\nthe port, e.g.\n\n \\\"https://matrix-client.matrix.org\\\"\n \\\"http://localhost:8080\\\"\n\n\\(fn &key USER-ID PASSWORD URI-PREFIX SESSION)\" t nil)\n\n(register-definition-prefixes \"ement\" '(\"ement-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-api\" \"ement-api.el\" (0 0 0 0))\n;;; Generated autoloads from ement-api.el\n\n(register-definition-prefixes \"ement-api\" '(\"ement-api-error\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-directory\" \"ement-directory.el\" (0 0\n;;;;;; 0 0))\n;;; Generated autoloads from ement-directory.el\n\n(autoload 'ement-directory \"ement-directory\" \"\\\nView the public room directory on SERVER with SESSION.\nShow up to LIMIT rooms. Interactively, with prefix, prompt for\nserver and LIMIT.\n\nSINCE may be a next-batch token.\n\n\\(fn &key SERVER SESSION SINCE (LIMIT 100))\" t nil)\n\n(autoload 'ement-directory-search \"ement-directory\" \"\\\nView public rooms on SERVER matching QUERY.\nQUERY is a string used to filter results.\n\n\\(fn QUERY &key SERVER SESSION SINCE (LIMIT 1000))\" t nil)\n\n(autoload 'ement-view-space \"ement-directory\" \"\\\nView child rooms in SPACE on SESSION.\nSPACE may be a room ID or an `ement-room' struct.\n\n\\(fn SPACE SESSION)\" t nil)\n\n(register-definition-prefixes \"ement-directory\" '(\"ement-directory-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-lib\" \"ement-lib.el\" (0 0 0 0))\n;;; Generated autoloads from ement-lib.el\n\n(register-definition-prefixes \"ement-lib\" '(\"ement-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-macros\" \"ement-macros.el\" (0 0 0 0))\n;;; Generated autoloads from ement-macros.el\n\n(register-definition-prefixes \"ement-macros\" '(\"ement-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-notify\" \"ement-notify.el\" (0 0 0 0))\n;;; Generated autoloads from ement-notify.el\n\n(register-definition-prefixes \"ement-notify\" '(\"ement-notify\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-room\" \"ement-room.el\" (0 0 0 0))\n;;; Generated autoloads from ement-room.el\n\n(register-definition-prefixes \"ement-room\" '(\"ement-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-room-list\" \"ement-room-list.el\" (0 0\n;;;;;; 0 0))\n;;; Generated autoloads from ement-room-list.el\n\n(autoload 'ement-room-list--after-initial-sync \"ement-room-list\" \"\\\nCall `ement-room-list', ignoring arguments.\nTo be called from `ement-after-initial-sync-hook'.\n\n\\(fn &rest IGNORE)\" nil nil)\n\n(defalias 'ement-list-rooms 'ement-room-list)\n\n(autoload 'ement-room-list \"ement-room-list\" \"\\\nShow a buffer listing Ement rooms, grouped with Taxy KEYS.\nAfter showing it, its window is selected. The buffer is named\nBUFFER-NAME and is shown with DISPLAY-BUFFER-ACTION; or if\nDISPLAY-BUFFER-ACTION is nil, the buffer is not displayed.\n\n\\(fn &key (BUFFER-NAME \\\"*Ement Room List*\\\") (KEYS ement-room-list-default-keys) (DISPLAY-BUFFER-ACTION \\\\='((display-buffer-reuse-window display-buffer-same-window))))\" t nil)\n\n(autoload 'ement-room-list-auto-update \"ement-room-list\" \"\\\nAutomatically update the Taxy room list buffer.\n+Does so when variable `ement-room-list-auto-update' is non-nil.\n+To be called in `ement-sync-callback-hook'.\n\n\\(fn SESSION)\" nil nil)\n\n(register-definition-prefixes \"ement-room-list\" '(\"ement-room-list-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"ement-tabulated-room-list\" \"ement-tabulated-room-list.el\"\n;;;;;; (0 0 0 0))\n;;; Generated autoloads from ement-tabulated-room-list.el\n\n(autoload 'ement-tabulated-room-list \"ement-tabulated-room-list\" \"\\\nShow buffer listing joined rooms.\nCalls `pop-to-buffer-same-window'. Interactively, with prefix,\ncall `pop-to-buffer'.\n\n\\(fn &rest IGNORE)\" t nil)\n\n(autoload 'ement-tabulated-room-list-auto-update \"ement-tabulated-room-list\" \"\\\nAutomatically update the room list buffer.\nDoes so when variable `ement-tabulated-room-list-auto-update' is non-nil.\nTo be called in `ement-sync-callback-hook'.\n\n\\(fn SESSION)\" nil nil)\n\n(register-definition-prefixes \"ement-tabulated-room-list\" '(\"ement-tabulated-room-list-\"))\n\n;;;***\n\f\n;;;### (autoloads nil nil (\"ement-pkg.el\" \"ement-structs.el\") (0\n;;;;;; 0 0 0))\n\n;;;***\n\f\n;; Local Variables:\n;; version-control: never\n;; no-byte-compile: t\n;; no-update-autoloads: t\n;; coding: utf-8\n;; End:\n;;; ement-autoloads.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-directory.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2045652,"end":2045694},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2045694},"to":{"change":3,"start":2026211,"end":2026211},"introduced_by":3}],"inode":{"change":3,"pos":2026211}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":2026211},"to":{"change":3,"start":2026212,"end":2045651},"introduced_by":3}],"inode":{"change":3,"pos":2026211}},"content":[{"Del":";;; ement-directory.el --- Public room directory support -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library provides support for viewing and searching public room directories on\n;; Matrix homeservers.\n\n;; To make rendering the list flexible and useful, we'll use `taxy-magit-section'.\n\n;;; Code:\n\n;;;; Requirements\n\n(require 'ement)\n(require 'ement-room-list)\n\n(require 'taxy)\n(require 'taxy-magit-section)\n\n;;;; Variables\n\n(defvar ement-directory-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"RET\") #'ement-directory-RET)\n (define-key map [mouse-1] #'ement-directory-mouse-1)\n (define-key map (kbd \"+\") #'ement-directory-next)\n map))\n\n(defgroup ement-directory nil\n \"Options for room directories.\"\n :group 'ement)\n\n;;;; Mode\n\n(define-derived-mode ement-directory-mode magit-section-mode \"Ement-Directory\"\n :global nil)\n\n(defvar-local ement-directory-etc nil\n \"Alist storing information in `ement-directory' buffers.\")\n\n;;;;; Keys\n\n(eval-and-compile\n (taxy-define-key-definer ement-directory-define-key\n ement-directory-keys \"ement-directory-key\" \"FIXME: Docstring.\"))\n\n;; TODO: Other keys like guest_can_join, world_readable, etc. (Last-updated time would be\n;; nice, but the server doesn't include that in the results.)\n\n(ement-directory-define-key joined-p ()\n (pcase-let (((map ('room_id id)) item)\n ((map session) ement-directory-etc))\n (when (cl-find id (ement-session-rooms session)\n :key #'ement-room-id :test #'equal)\n \"Joined\")))\n\n(ement-directory-define-key size (&key < >)\n (pcase-let (((map ('num_joined_members size)) item))\n (cond ((and < (< size <))\n (format \"< %s members\" <))\n ((and > (> size >))\n (format \"> %s members\" >)))))\n\n(ement-directory-define-key space-p ()\n \"Groups rooms that are themselves spaces.\"\n (pcase-let (((map ('room_type type)) item))\n (when (equal \"m.space\" type)\n \"Spaces\")))\n\n(defcustom ement-directory-default-keys\n '((joined-p)\n (space-p)\n ((size :> 10000))\n ((size :> 1000))\n ((size :> 100))\n ((size :> 10))\n ((size :< 11)))\n \"Default keys.\"\n :type 'sexp)\n\n;;;; Columns\n\n(defvar-local ement-directory-room-avatar-cache (make-hash-table)\n ;; Use a buffer-local variable so that the cache is cleared when the buffer is closed.\n \"Hash table caching room avatars for the `ement-directory' room list.\")\n\n(eval-and-compile\n (taxy-magit-section-define-column-definer \"ement-directory\"))\n\n;; TODO: Fetch avatars (with queueing and async updating/insertion?).\n\n(ement-directory-define-column #(\"✓\" 0 1 (help-echo \"Joined\")) ()\n (pcase-let (((map ('room_id id)) item)\n ((map session) ement-directory-etc))\n (if (cl-find id (ement-session-rooms session)\n :key #'ement-room-id :test #'equal)\n \"✓\"\n \" \")))\n\n(ement-directory-define-column \"Name\" (:max-width 25)\n (pcase-let* (((map name ('room_type type)) item)\n (face (pcase type\n (\"m.space\" 'ement-room-list-space)\n (_ 'ement-room-list-name))))\n (propertize (or name \"[unnamed]\")\n 'face face)))\n\n(ement-directory-define-column \"Alias\" (:max-width 25)\n (pcase-let (((map ('canonical_alias alias)) item))\n (or alias \"\")))\n\n(ement-directory-define-column \"Size\" ()\n (pcase-let (((map ('num_joined_members size)) item))\n (number-to-string size)))\n\n(ement-directory-define-column \"Topic\" (:max-width 50)\n (pcase-let (((map topic) item))\n (if topic\n (replace-regexp-in-string \"\\n\" \" | \" topic nil t)\n \"\")))\n\n(ement-directory-define-column \"ID\" ()\n (pcase-let (((map ('room_id id)) item))\n id))\n\n(unless ement-directory-columns\n ;; TODO: Automate this or document it\n (setq-default ement-directory-columns\n '(\"Name\" \"Alias\" \"Size\" \"Topic\" \"ID\")))\n\n;;;; Commands\n\n;; TODO: Pagination of results.\n\n;;;###autoload\n(cl-defun ement-directory (&key server session since (limit 100))\n \"View the public room directory on SERVER with SESSION.\nShow up to LIMIT rooms. Interactively, with prefix, prompt for\nserver and LIMIT.\n\nSINCE may be a next-batch token.\"\n (interactive (let* ((session (ement-complete-session :prompt \"Search on session: \"))\n (server (if current-prefix-arg\n (read-string \"Search on server: \" nil nil\n (ement-server-name (ement-session-server session)))\n (ement-server-name (ement-session-server session))))\n (args (list :server server :session session)))\n (when current-prefix-arg\n (cl-callf plist-put args\n :limit (read-number \"Limit number of rooms: \" 100)))\n args))\n (pcase-let ((revert-function (lambda (&rest _ignore)\n (interactive)\n (ement-directory :server server :session session :limit limit)))\n (endpoint \"publicRooms\")\n (params (list (list \"limit\" limit))))\n (when since\n (cl-callf append params (list (list \"since\" since))))\n (ement-api session endpoint :params params\n :then (lambda (results)\n (pcase-let (((map ('chunk rooms) ('next_batch next-batch)\n ('total_room_count_estimate remaining))\n results))\n (ement-directory--view rooms :append-p since\n :buffer-name (format \"*Ement Directory: %s*\" server)\n :root-section-name (format \"Ement Directory: %s\" server)\n :init-fn (lambda ()\n (setf (alist-get 'server ement-directory-etc) server\n (alist-get 'session ement-directory-etc) session\n (alist-get 'next-batch ement-directory-etc) next-batch\n (alist-get 'limit ement-directory-etc) limit)\n (setq-local revert-buffer-function revert-function)\n (when remaining\n ;; FIXME: The server seems to report all of the rooms on\n ;; the server as remaining even when searching for a\n ;; specific term like \"emacs\".\n ;; TODO: Display this in a more permanent place (like a\n ;; header or footer).\n (message\n (substitute-command-keys\n \"%s rooms remaining (use \\\\[ement-directory-next] to fetch more)\")\n remaining)))))))\n (ement-message \"Listing %s rooms on %s...\" limit server)))\n\n;;;###autoload\n(cl-defun ement-directory-search (query &key server session since (limit 1000))\n \"View public rooms on SERVER matching QUERY.\nQUERY is a string used to filter results.\"\n (interactive (let* ((session (ement-complete-session :prompt \"Search on session: \"))\n (server (if current-prefix-arg\n (read-string \"Search on server: \" nil nil\n (ement-server-name (ement-session-server session)))\n (ement-server-name (ement-session-server session))))\n (query (read-string (format \"Search for rooms on %s matching: \" server)))\n (args (list query :server server :session session)))\n (when current-prefix-arg\n (cl-callf plist-put (cdr args)\n :limit (read-number \"Limit number of rooms: \" 1000)))\n args))\n ;; TODO: Handle \"include_all_networks\" and \"third_party_instance_id\". See § 10.5.4.\n (pcase-let* ((revert-function (lambda (&rest _ignore)\n (interactive)\n (ement-directory-search query :server server :session session)))\n (endpoint \"publicRooms\")\n (data (rassq-delete-all nil\n (ement-alist \"limit\" limit\n \"filter\" (ement-alist \"generic_search_term\" query)\n \"since\" since))))\n (ement-api session endpoint :method 'post :data (json-encode data)\n :then (lambda (results)\n (pcase-let (((map ('chunk rooms) ('next_batch next-batch)\n ('total_room_count_estimate remaining))\n results))\n (ement-directory--view rooms :append-p since\n :buffer-name (format \"*Ement Directory: \\\"%s\\\" on %s*\" query server)\n :root-section-name (format \"Ement Directory: \\\"%s\\\" on %s\" query server)\n :init-fn (lambda ()\n (setf (alist-get 'server ement-directory-etc) server\n (alist-get 'session ement-directory-etc) session\n (alist-get 'next-batch ement-directory-etc) next-batch\n (alist-get 'limit ement-directory-etc) limit\n (alist-get 'query ement-directory-etc) query)\n (setq-local revert-buffer-function revert-function)\n (when remaining\n (message\n (substitute-command-keys\n \"%s rooms remaining (use \\\\[ement-directory-next] to fetch more)\")\n remaining)))))))\n (ement-message \"Searching for %S on %s...\" query server)))\n\n(defun ement-directory-next ()\n \"Fetch next batch of results in `ement-directory' buffer.\"\n (interactive)\n (pcase-let (((map next-batch query limit server session) ement-directory-etc))\n (unless next-batch\n (user-error \"No more results\"))\n (if query\n (ement-directory-search query :server server :session session :limit limit :since next-batch)\n (ement-directory :server server :session session :limit limit :since next-batch))))\n\n(defun ement-directory-mouse-1 (event)\n \"Call `ement-directory-RET' at EVENT.\"\n (interactive \"e\")\n (mouse-set-point event)\n (call-interactively #'ement-directory-RET))\n\n(defun ement-directory-RET ()\n \"View or join room at point, or cycle section at point.\"\n (interactive)\n (cl-etypecase (oref (magit-current-section) value)\n (null nil)\n (list (pcase-let* (((map ('name name) ('room_id room-id)) (oref (magit-current-section) value))\n ((map session) ement-directory-etc)\n (room (cl-find room-id (ement-session-rooms session)\n :key #'ement-room-id :test #'equal)))\n (if room\n (ement-view-room room session)\n ;; Room not joined: prompt to join. (Don't use the alias in the prompt,\n ;; because multiple rooms might have the same alias, e.g. when one is\n ;; upgraded or tombstoned.)\n (when (yes-or-no-p (format \"Join room \\\"%s\\\" <%s>? \" name room-id))\n (ement-join-room room-id session)))))\n (taxy-magit-section (call-interactively #'magit-section-cycle))))\n\n;;;; Functions\n\n(cl-defun ement-directory--view (rooms &key init-fn append-p\n (buffer-name \"*Ement Directory*\")\n (root-section-name \"Ement Directory\")\n (keys ement-directory-default-keys)\n (display-buffer-action '(display-buffer-same-window)))\n \"View ROOMS in an `ement-directory-mode' buffer.\nROOMS should be a list of rooms from an API request. Calls\nINIT-FN immediately after activating major mode. Sets\nBUFFER-NAME and ROOT-SECTION-NAME, and uses\nDISPLAY-BUFFER-ACTION. KEYS are a list of `taxy' keys. If\nAPPEND-P, add ROOMS to buffer rather than replacing existing\ncontents. To be called by `ement-directory-search'.\"\n (declare (indent defun))\n (let (column-sizes window-start)\n (cl-labels ((format-item\n ;; NOTE: We use the buffer-local variable `ement-directory-etc' rather\n ;; than a closure variable because the taxy-magit-section struct's format\n ;; table is not stored in it, and we can't reuse closures' variables.\n ;; (It would be good to store the format table in the taxy-magit-section\n ;; in the future, to make this cleaner.)\n (item) (gethash item (alist-get 'format-table ement-directory-etc)))\n ;; NOTE: Since these functions take an \"item\" (which is a [room session]\n ;; vector), they're prefixed \"item-\" rather than \"room-\".\n (size\n (item) (pcase-let (((map ('num_joined_members size)) item))\n size))\n (tnil (a b) (and (not a) b))\n (make-fn (&rest args)\n (apply #'make-taxy-magit-section\n :make #'make-fn\n :format-fn #'format-item\n ;; FIXME: Should we reuse `ement-room-list-level-indent' here?\n :level-indent ement-room-list-level-indent\n ;; :visibility-fn #'visible-p\n ;; :heading-indent 2\n :item-indent 2\n ;; :heading-face-fn #'heading-face\n args)))\n (with-current-buffer (get-buffer-create buffer-name)\n (unless (eq 'ement-directory-mode major-mode)\n ;; Don't obliterate buffer-local variables.\n (ement-directory-mode))\n (when init-fn\n (funcall init-fn))\n (pcase-let* ((taxy (if append-p\n (alist-get 'taxy ement-directory-etc)\n (make-fn\n :name root-section-name\n :take (taxy-make-take-function keys ement-directory-keys))))\n (taxy-magit-section-insert-indent-items nil)\n (inhibit-read-only t)\n (pos (point))\n (section-ident (when (magit-current-section)\n (magit-section-ident (magit-current-section))))\n (format-cons))\n (setf taxy (thread-last taxy\n (taxy-fill (cl-coerce rooms 'list))\n (taxy-sort #'> #'size)\n (taxy-sort* #'string> #'taxy-name))\n (alist-get 'taxy ement-directory-etc) taxy\n format-cons (taxy-magit-section-format-items\n ement-directory-columns ement-directory-column-formatters taxy)\n (alist-get 'format-table ement-directory-etc) (car format-cons)\n column-sizes (cdr format-cons)\n header-line-format (taxy-magit-section-format-header\n column-sizes ement-directory-column-formatters)\n window-start (if (get-buffer-window buffer-name)\n (window-start (get-buffer-window buffer-name))\n 0))\n (delete-all-overlays)\n (erase-buffer)\n (save-excursion\n (taxy-magit-section-insert taxy :items 'first\n ;; :blank-between-depth bufler-taxy-blank-between-depth\n :initial-depth 0))\n (goto-char pos)\n (when (and section-ident (magit-get-section section-ident))\n (goto-char (oref (magit-get-section section-ident) start)))))\n (display-buffer buffer-name display-buffer-action)\n (when (get-buffer-window buffer-name)\n (set-window-start (get-buffer-window buffer-name) window-start))\n ;; NOTE: In order for `bookmark--jump-via' to work properly, the restored buffer\n ;; must be set as the current buffer, so we have to do this explicitly here.\n (set-buffer buffer-name))))\n\n;;;; Spaces\n\n;; Viewing spaces and the rooms in them.\n\n;;;###autoload\n(defun ement-view-space (space session)\n ;; TODO: Use this for spaces instead of `ement-view-room' (or something like that).\n ;; TODO: Display space's topic in the header or something.\n \"View child rooms in SPACE on SESSION.\nSPACE may be a room ID or an `ement-room' struct.\"\n ;; TODO: \"from\" query parameter.\n (interactive (ement-complete-room :predicate #'ement--room-space-p\n :prompt \"Space: \"))\n (pcase-let* ((id (cl-typecase space\n (string space)\n (ement-room (ement-room-id space))))\n (endpoint (format \"rooms/%s/hierarchy\" id))\n (revert-function (lambda (&rest _ignore)\n (interactive)\n (ement-view-space space session))))\n (ement-api session endpoint :version \"v1\"\n :then (lambda (results)\n (pcase-let (((map rooms ('next_batch next-batch))\n results))\n (ement-directory--view rooms ;; :append-p since\n ;; TODO: Use space's alias where possible.\n :buffer-name (format \"*Ement Directory: space \\\"%s\\\"\" id)\n :root-section-name (format \"*Ement Directory: space \\\"%s\\\"\" id)\n :init-fn (lambda ()\n (setf (alist-get 'session ement-directory-etc) session\n (alist-get 'next-batch ement-directory-etc) next-batch\n ;; (alist-get 'limit ement-directory-etc) limit\n (alist-get 'space ement-directory-etc) space)\n (setq-local revert-buffer-function revert-function)\n ;; TODO: Handle next batches.\n ;; (when remaining\n ;; (message\n ;; (substitute-command-keys\n ;; \"%s rooms remaining (use \\\\[ement-directory-next] to fetch more)\")\n ;; remaining))\n )))))))\n\n;;;; Footer\n\n(provide 'ement-directory)\n;;; ement-directory.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-lib.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":2026173,"end":2026209},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":2026209},"to":{"change":3,"start":1931588,"end":1931588},"introduced_by":3}],"inode":{"change":3,"pos":1931588}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1931588},"to":{"change":3,"start":1931589,"end":2026172},"introduced_by":3}],"inode":{"change":3,"pos":1931588}},"content":[{"Del":";;; ement-lib.el --- Library of Ement functions -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library provides functions used in other Ement libraries. It exists so they may\n;; be required where needed, without causing circular dependencies.\n\n;;; Code:\n\n;;;; Requirements\n\n(eval-when-compile\n (require 'eieio)\n (require 'ewoc)\n (require 'pcase)\n (require 'subr-x)\n \n (require 'taxy-magit-section)\n\n (require 'ement-macros))\n\n(require 'cl-lib)\n\n(require 'color)\n(require 'map)\n(require 'xml)\n\n(require 'ement-api)\n(require 'ement-structs)\n\n;;;; Variables\n\n(defvar ement-sessions)\n(defvar ement-users)\n(defvar ement-ewoc)\n(defvar ement-room)\n(defvar ement-session)\n\n(defvar ement-room-buffer-name-prefix)\n(defvar ement-room-buffer-name-suffix)\n(defvar ement-room-leave-kill-buffer)\n(defvar ement-room-prism)\n(defvar ement-room-prism-color-adjustment)\n(defvar ement-room-prism-minimum-contrast)\n(defvar ement-room-unread-only-counts-notifications)\n\n;;;; Function declarations\n\n;; Instead of using top-level `declare-function' forms (which can easily become obsolete\n;; if not kept with the code that needs them), this allows the use of `(declare (function\n;; ...))' forms in each function definition, so that if a function is moved or removed,\n;; the `declare-function' goes with it.\n\n;; TODO: Propose this upstream.\n\n(eval-and-compile\n (defun ement--byte-run--declare-function (_name _args &rest values)\n \"Return a `declare-function' form with VALUES.\nAllows the use of a form like:\n\n (declare (function FN FILE ...))\n\ninside of a function definition, effectively keeping its\n`declare-function' form inside the function definition, ensuring\nthat stray such forms don't remain if the function is removed.\"\n `(declare-function ,@values))\n\n (cl-pushnew '(function ement--byte-run--declare-function) defun-declarations-alist :test #'equal)\n (cl-pushnew '(function ement--byte-run--declare-function) macro-declarations-alist :test #'equal))\n\n;;;; Compatibility\n\n;; These workarounds should be removed when they aren't needed.\n\n;;;;; Emacs 28 color features.\n\n;; Copied from Emacs 28. See .\n\n;; FIXME: Remove this workaround when possible.\n\n(eval-and-compile\n (unless (boundp 'color-luminance-dark-limit)\n (defconst ement--color-luminance-dark-limit 0.325\n \"The relative luminance below which a color is considered 'dark'.\nA 'dark' color in this sense provides better contrast with white\nthan with black; see `color-dark-p'.\nThis value was determined experimentally.\")))\n\n(defalias 'ement--color-dark-p\n (if (fboundp 'color-dark-p)\n 'color-dark-p\n (lambda (rgb)\n \"Whether RGB is more readable against white than black.\nRGB is a 3-element list (R G B), each component in the range [0,1].\nThis predicate can be used both for determining a suitable (black or white)\ncontrast colour with RGB as background and as foreground.\"\n (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1)\n (error \"RGB components %S not in [0,1]\" rgb))\n ;; Compute the relative luminance after gamma-correcting (assuming sRGB),\n ;; and compare to a cut-off value determined experimentally.\n ;; See https://en.wikipedia.org/wiki/Relative_luminance for details.\n (let* ((sr (nth 0 rgb))\n (sg (nth 1 rgb))\n (sb (nth 2 rgb))\n ;; Gamma-correct the RGB components to linear values.\n ;; Use the power 2.2 as an approximation to sRGB gamma;\n ;; it should be good enough for the purpose of this function.\n (r (expt sr 2.2))\n (g (expt sg 2.2))\n (b (expt sb 2.2))\n (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722))))\n (< y ement--color-luminance-dark-limit)))))\n\n;;;; Functions\n\n;;;;; Commands\n\n(cl-defun ement-create-room\n (session &key name alias topic invite direct-p creation-content\n (then (lambda (data)\n (message \"Created new room: %s\" (alist-get 'room_id data))))\n (visibility 'private))\n \"Create new room on SESSION.\nThen call function THEN with response data. Optional string\narguments are NAME, ALIAS, and TOPIC. INVITE may be a list of\nuser IDs to invite. If DIRECT-P, set the \\\"is_direct\\\" flag in\nthe request. CREATION-CONTENT may be an alist of extra keys to\ninclude with the request (see Matrix spec).\"\n ;; TODO: Document other arguments.\n ;; SPEC: 10.1.1.\n (declare (indent defun))\n (interactive (list (ement-complete-session)\n\t\t :name (read-string \"New room name: \")\n\t\t :alias (read-string \"New room alias (e.g. \\\"foo\\\" for \\\"#foo:matrix.org\\\"): \")\n\t\t :topic (read-string \"New room topic: \")\n\t\t :visibility (completing-read \"New room visibility: \" '(private public))))\n (cl-labels ((given-p\n\t (var) (and var (not (string-empty-p var)))))\n (pcase-let* ((endpoint \"createRoom\")\n\t\t (data (ement-aprog1\n\t\t\t (ement-alist \"visibility\" visibility)\n\t\t\t (when (given-p alias)\n\t\t\t (push (cons \"room_alias_name\" alias) it))\n\t\t\t (when (given-p name)\n\t\t\t (push (cons \"name\" name) it))\n\t\t\t (when (given-p topic)\n\t\t\t (push (cons \"topic\" topic) it))\n\t\t\t (when invite\n\t\t\t (push (cons \"invite\" invite) it))\n\t\t\t (when direct-p\n\t\t\t (push (cons \"is_direct\" t) it))\n (when creation-content\n (push (cons \"creation_content\" creation-content) it)))))\n (ement-api session endpoint :method 'post :data (json-encode data)\n :then then))))\n\n(cl-defun ement-create-space\n (session &key name alias topic\n (then (lambda (data)\n (message \"Created new space: %s\" (alist-get 'room_id data))))\n (visibility 'private))\n \"Create new space on SESSION.\nThen call function THEN with response data. Optional string\narguments are NAME, ALIAS, and TOPIC.\"\n (declare (indent defun))\n (interactive (list (ement-complete-session)\n\t\t :name (read-string \"New space name: \")\n\t\t :alias (read-string \"New space alias (e.g. \\\"foo\\\" for \\\"#foo:matrix.org\\\"): \")\n\t\t :topic (read-string \"New space topic: \")\n\t\t :visibility (completing-read \"New space visibility: \" '(private public))))\n (ement-create-room session :name name :alias alias :topic topic :visibility visibility\n :creation-content (ement-alist \"type\" \"m.space\") :then then))\n\n(defun ement-room-leave (room session &optional force-p)\n \"Leave ROOM on SESSION.\nIf FORCE-P, leave without prompting. ROOM may be an `ement-room'\nstruct, or a room ID or alias string.\"\n ;; TODO: Rename `room' argument to `room-or-id'.\n (interactive\n (ement-with-room-and-session\n :prompt-form (ement-complete-room :prompt \"Leave room: \")\n (list ement-room ement-session)))\n (cl-etypecase room\n (ement-room)\n (string (setf room (ement-afirst (or (equal room (ement-room-canonical-alias it))\n (equal room (ement-room-id it)))\n (ement-session-rooms session)))))\n (when (or force-p (yes-or-no-p (format \"Leave room %s? \" (ement--format-room room))))\n (pcase-let* (((cl-struct ement-room id) room)\n (endpoint (format \"rooms/%s/leave\" (url-hexify-string id))))\n (ement-api session endpoint :method 'post :data \"\"\n :then (lambda (_data)\n (when ement-room-leave-kill-buffer\n ;; NOTE: This generates a symbol and sets its function value to a lambda\n ;; which removes the symbol from the hook, removing itself from the hook.\n ;; TODO: When requiring Emacs 27, use `letrec'.\n (let* ((leave-fn-symbol (gensym (format \"ement-leave-%s\" room)))\n (leave-fn (lambda (_session)\n (remove-hook 'ement-sync-callback-hook leave-fn-symbol)\n ;; FIXME: Probably need to unintern the symbol.\n (when-let ((buffer (map-elt (ement-room-local room) 'buffer)))\n (when (buffer-live-p buffer)\n (kill-buffer buffer))))))\n (setf (symbol-function leave-fn-symbol) leave-fn)\n (add-hook 'ement-sync-callback-hook leave-fn-symbol)))\n (ement-message \"Left room: %s\" (ement--format-room room)))\n :else (lambda (plz-error)\n (pcase-let* (((cl-struct plz-error response) plz-error)\n ((cl-struct plz-response status body) response)\n ((map error) (json-read-from-string body)))\n (pcase status\n (429 (error \"Unable to leave room %s: %s\" room error))\n (_ (error \"Unable to leave room %s: %s %S\" room status plz-error)))))))))\n(defalias 'ement-leave-room #'ement-room-leave)\n\n(defun ement-forget-room (room session &optional force-p)\n \"Forget ROOM on SESSION.\nIf FORCE-P (interactively, with prefix), prompt to leave the room\nwhen necessary, and forget the room without prompting.\"\n (interactive\n (ement-with-room-and-session\n :prompt-form (ement-complete-room :prompt \"Forget room: \")\n (list ement-room ement-session current-prefix-arg)))\n (pcase-let* (((cl-struct ement-room id display-name status) room)\n (endpoint (format \"rooms/%s/forget\" (url-hexify-string id))))\n (pcase status\n ('join (if (and force-p\n (yes-or-no-p (format \"Leave and forget room %s? (WARNING: You will not be able to rejoin the room to access its content.) \"\n (ement--format-room room))))\n (progn\n ;; TODO: Use `letrec'.\n (let* ((forget-fn-symbol (gensym (format \"ement-forget-%s\" room)))\n (forget-fn (lambda (_session)\n (when (equal 'leave (ement-room-status room))\n (remove-hook 'ement-sync-callback-hook forget-fn-symbol)\n ;; FIXME: Probably need to unintern the symbol.\n (ement-forget-room room session 'force)))))\n (setf (symbol-function forget-fn-symbol) forget-fn)\n (add-hook 'ement-sync-callback-hook forget-fn-symbol))\n (ement-leave-room room session 'force))\n (user-error \"Room %s is joined (must be left before forgetting)\"\n (ement--format-room room))))\n ('leave (when (or force-p (yes-or-no-p (format \"Forget room \\\"%s\\\" (%s)? \" display-name id)))\n (ement-api session endpoint :method 'post :data \"\"\n :then (lambda (_data)\n ;; NOTE: The spec does not seem to indicate that the action of forgetting\n ;; a room is synced to other clients, so it seems that we need to remove\n ;; the room from the session here.\n (setf (ement-session-rooms session)\n (cl-remove room (ement-session-rooms session)))\n ;; TODO: Indicate forgotten in footer in room buffer.\n (ement-message \"Forgot room: %s.\" (ement--format-room room)))))))))\n\n(defun ement-ignore-user (user-id session &optional unignore-p)\n \"Ignore USER-ID on SESSION.\nIf UNIGNORE-P (interactively, with prefix), un-ignore USER.\"\n (interactive (list (ement-complete-user-id)\n (ement-complete-session)\n current-prefix-arg))\n (pcase-let* (((cl-struct ement-session account-data) session)\n ;; TODO: Store session account-data events in an alist keyed on type.\n ((map ('content (map ('ignored_users ignored-users))))\n (cl-find \"m.ignored_user_list\" account-data\n :key (lambda (event) (alist-get 'type event)) :test #'equal)))\n (if unignore-p\n ;; Being map keys, the user IDs have been interned by `json-read'.\n (setf ignored-users (map-delete ignored-users (intern user-id)))\n ;; Empty maps are used to list ignored users.\n (setf (map-elt ignored-users user-id) nil))\n (ement-put-account-data session \"m.ignored_user_list\" (ement-alist \"ignored_users\" ignored-users)\n :then (lambda (data)\n (ement-debug \"PUT successful\" data)\n (message \"Ement: User %s %s.\" user-id (if unignore-p \"unignored\" \"ignored\"))))))\n\n(defun ement-invite-user (user-id room session)\n \"Invite USER-ID to ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\"\n ;; SPEC: 10.4.2.1.\n (interactive\n (ement-with-room-and-session\n (list (ement-complete-user-id) ement-room ement-session)))\n (pcase-let* ((endpoint (format \"rooms/%s/invite\"\n (url-hexify-string (ement-room-id room))))\n (data (ement-alist \"user_id\" user-id) ))\n (ement-api session endpoint :method 'post :data (json-encode data)\n ;; TODO: Handle error codes.\n :then (lambda (_data)\n (message \"User %s invited to room \\\"%s\\\" (%s)\" user-id\n (ement-room-display-name room)\n (ement-room-id room))))))\n\n(defun ement-list-members (room session bufferp)\n \"Show members of ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room. If BUFFERP (interactively, with\nprefix), or if there are many members, show in a new buffer;\notherwise show in echo area.\"\n (interactive\n (ement-with-room-and-session\n (list ement-room ement-session current-prefix-arg)))\n (pcase-let* (((cl-struct ement-room members (local (map fetched-members-p))) room)\n (list-members\n (lambda (&optional _)\n (cond ((or bufferp (> (hash-table-count members) 51))\n ;; Show in buffer.\n (let* ((buffer (get-buffer-create (format \"*Ement members: %s*\" (ement-room-display-name room))))\n (members (cl-sort (cl-loop for user being the hash-values of members\n for id = (ement-user-id user)\n for displayname = (ement--user-displayname-in room user)\n collect (cons displayname id))\n (lambda (a b) (string-collate-lessp a b nil t)) :key #'car))\n (displayname-width (cl-loop for member in members\n maximizing (string-width (car member))))\n (format-string (format \"%%-%ss <%%s>\" displayname-width)))\n (with-current-buffer buffer\n (erase-buffer)\n (save-excursion\n (dolist (member members)\n (insert (format format-string (car member) (cdr member)) \"\\n\"))))\n (pop-to-buffer buffer)))\n (t\n ;; Show in echo area.\n (message \"Members of %s (%s): %s\" (ement--room-display-name room)\n (hash-table-count members)\n (string-join (map-apply (lambda (_id user)\n (ement--user-displayname-in room user))\n members)\n \", \")))))))\n (if fetched-members-p\n (funcall list-members)\n (ement--get-joined-members room session\n :then list-members))\n (message \"Listing members of %s...\" (ement--format-room room))))\n\n(defun ement-send-direct-message (session user-id message)\n \"Send a direct MESSAGE to USER-ID on SESSION.\nUses the latest existing direct room with the user, or creates a\nnew one automatically if necessary.\"\n ;; SPEC: 13.23.2.\n (interactive\n (let* ((session (ement-complete-session))\n\t (user-id (ement-complete-user-id))\n\t (message (read-string \"Message: \")))\n (list session user-id message)))\n (if-let* ((seen-user (gethash user-id ement-users))\n\t (existing-direct-room (ement--direct-room-for-user seen-user session)))\n (progn\n (ement-send-message existing-direct-room session :body message)\n (message \"Message sent to %s <%s> in room %S <%s>.\"\n (ement--user-displayname-in existing-direct-room seen-user)\n user-id\n (ement-room-display-name existing-direct-room) (ement-room-id existing-direct-room)))\n ;; No existing room for user: make new one.\n (message \"Creating new room for user %s...\" user-id)\n (ement-create-room session :direct-p t :invite (list user-id)\n :then (lambda (data)\n (let* ((room-id (alist-get 'room_id data))\n\t (room (or (cl-find room-id (ement-session-rooms session)\n :key #'ement-room-id)\n\t\t ;; New room hasn't synced yet: make a temporary struct.\n\t\t (make-ement-room :id room-id)))\n (direct-rooms-account-data-event-content\n ;; FIXME: Make account-data a map.\n (alist-get 'content (cl-find-if (lambda (event)\n (equal \"m.direct\" (alist-get 'type event)))\n (ement-session-account-data session)))))\n ;; Mark new room as direct: add the room to the account-data event, then\n ;; put the new account data to the server. (See also:\n ;; ).\n (setf (map-elt direct-rooms-account-data-event-content user-id) (vector room-id))\n (ement-put-account-data session \"m.direct\" direct-rooms-account-data-event-content)\n ;; Send message to new room.\n (ement-send-message room session :body message)\n (message \"Room \\\"%s\\\" created for user %s. Sending message...\"\n\t room-id user-id))))))\n\n(defun ement-tag-room (tag room session)\n \"Toggle TAG for ROOM on SESSION.\"\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Toggle tag (%s): \" (ement--format-room ement-room)))\n (default-tags\n (ement-alist (propertize \"Favourite\"\n 'face (when (ement--room-tagged-p \"m.favourite\" ement-room)\n 'transient-value))\n \"m.favourite\"\n (propertize \"Low-priority\"\n 'face (when (ement--room-tagged-p \"m.lowpriority\" ement-room)\n 'transient-value))\n \"m.lowpriority\"))\n (input (completing-read prompt default-tags))\n (tag (alist-get input default-tags (concat \"u.\" input) nil #'string=)))\n (list tag ement-room ement-session))))\n (pcase-let* (((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user)\n ((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"user/%s/rooms/%s/tags/%s\"\n (url-hexify-string user-id) (url-hexify-string room-id) (url-hexify-string tag)))\n (method (if (ement--room-tagged-p tag room) 'delete 'put)))\n ;; TODO: \"order\".\n ;; FIXME: Removing a tag on a left room doesn't seem to work (e.g. to unfavorite a room after leaving it, but not forgetting it).\n (ement-api session endpoint :version \"v3\" :method method :data (pcase method ('put \"{}\"))\n :then (lambda (_)\n (ement-message \"%s tag %S on %s\"\n (pcase method\n ('delete \"Removed\")\n ('put \"Added\"))\n tag (ement--format-room room)) ))))\n\n(defun ement-set-display-name (display-name session)\n \"Set DISPLAY-NAME for user on SESSION.\nSets global displayname.\"\n (interactive\n (let* ((session (ement-complete-session))\n (display-name (read-string \"Set display-name to: \" nil nil\n (ement-user-displayname (ement-session-user session)))))\n (list display-name session)))\n (pcase-let* (((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user)\n (endpoint (format \"profile/%s/displayname\" (url-hexify-string user-id))))\n (ement-api session endpoint :method 'put :version \"v3\"\n :data (json-encode (ement-alist \"displayname\" display-name))\n :then (lambda (_data)\n (message \"Ement: Display name set to %S for <%s>\" display-name\n (ement-user-id (ement-session-user session)))))))\n\n(defun ement-room-set-display-name (display-name room session)\n \"Set DISPLAY-NAME for user in ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room. Sets the name only in ROOM, not\nglobally.\"\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Set display-name in %S to: \"\n (ement--format-room ement-room)))\n (display-name (read-string prompt nil nil\n (ement-user-displayname (ement-session-user ement-session)))))\n (list display-name ement-room ement-session))))\n ;; NOTE: This does not seem to be documented in the spec, so we imitate the\n ;; \"/myroomnick\" command in SlashCommands.tsx from matrix-react-sdk.\n (pcase-let* (((cl-struct ement-room state) room)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-user id) user)\n (member-event (cl-find-if (lambda (event)\n (and (equal id (ement-event-state-key event))\n (equal \"m.room.member\" (ement-event-type event))\n (equal \"join\" (alist-get 'membership (ement-event-content event)))))\n state)))\n (cl-assert member-event)\n (setf (alist-get 'displayname (ement-event-content member-event)) display-name)\n (ement-put-state room \"m.room.member\" id (ement-event-content member-event) session\n :then (lambda (_data)\n (message \"Ement: Display name set to %S for <%s> in %S\" display-name\n (ement-user-id (ement-session-user session))\n (ement--format-room room))))))\n\n;;;;;; Describe room\n\n(defvar ement-describe-room-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"q\") #'quit-window)\n map)\n \"Keymap for `ement-describe-room-mode' buffers.\")\n\n(define-derived-mode ement-describe-room-mode read-only-mode\n \"Ement-Describe-Room\" \"Major mode for `ement-describe-room' buffers.\")\n\n(defun ement-describe-room (room session)\n \"Describe ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\"\n (interactive (ement-with-room-and-session (list ement-room ement-session)))\n (cl-labels ((heading (string)\n (propertize (or string \"\") 'face 'font-lock-builtin-face))\n (id (string)\n (propertize (or string \"\") 'face 'font-lock-constant-face))\n (member<\n (a b) (string-collate-lessp (car a) (car b) nil t)))\n (pcase-let* (((cl-struct ement-room (id room-id) avatar display-name canonical-alias members timeline status topic\n (local (map fetched-members-p)))\n room)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user)\n (inhibit-read-only t))\n (if (not fetched-members-p)\n ;; Members not fetched: fetch them and re-call this command.\n (ement--get-joined-members room session\n :then (lambda (_) (ement-room-describe room session)))\n (with-current-buffer (get-buffer-create (format \"*Ement room description: %s*\" (or display-name canonical-alias room-id)))\n (let ((inhibit-read-only t))\n (erase-buffer)\n ;; We avoid looping twice by doing a bit more work here and\n ;; returning a cons which we destructure.\n (pcase-let* ((`(,member-pairs . ,name-width)\n (cl-loop for user being the hash-values of members\n for formatted = (ement--format-user user room session)\n for id = (format \"<%s>\" (id (ement-user-id user)))\n collect (cons formatted id)\n into pairs\n maximizing (string-width id) into width\n finally return (cons (cl-sort pairs #'member<) width)))\n ;; We put the MXID first, because users may use Unicode characters\n ;; in their displayname, which `string-width' does not always\n ;; return perfect results for, and putting it last prevents\n ;; alignment problems.\n (spec (format \"%%-%ss %%s\" name-width)))\n (save-excursion\n (insert \"\\\"\" (propertize (or display-name canonical-alias room-id) 'face 'font-lock-doc-face) \"\\\"\" \" is a room \"\n (propertize (pcase status\n ('invite \"invited\")\n ('join \"joined\")\n ('leave \"left\")\n (_ (symbol-name status)))\n 'face 'font-lock-comment-face)\n \" on session <\" (id user-id) \">.\\n\\n\"\n (heading \"Avatar: \") (or avatar \"\") \"\\n\\n\"\n (heading \"ID: \") \"<\" (id room-id) \">\" \"\\n\"\n (heading \"Alias: \") \"<\" (id canonical-alias) \">\" \"\\n\\n\"\n (heading \"Topic: \") (propertize (or topic \"[none]\") 'face 'font-lock-comment-face) \"\\n\\n\"\n (heading \"Retrieved events: \") (number-to-string (length timeline)) \"\\n\"\n (heading \" spanning: \")\n (format-time-string \"%Y-%m-%d %H:%M:%S\"\n (/ (ement-event-origin-server-ts\n (car (cl-sort (copy-sequence timeline) #'< :key #'ement-event-origin-server-ts)))\n 1000))\n (heading \" to \")\n (format-time-string \"%Y-%m-%d %H:%M:%S\\n\\n\"\n (/ (ement-event-origin-server-ts\n (car (cl-sort (copy-sequence timeline) #'> :key #'ement-event-origin-server-ts)))\n 1000))\n (heading \"Members\") \" (\" (number-to-string (hash-table-count members)) \"):\\n\")\n (pcase-dolist (`(,formatted . ,id) member-pairs)\n (insert \" \" (format spec id formatted) \"\\n\")))))\n (unless (eq major-mode 'ement-describe-room-mode)\n ;; Without this check, activating the mode again causes a \"Cyclic keymap\n ;; inheritance\" error.\n (ement-describe-room-mode))\n (pop-to-buffer (current-buffer)))))))\n\n(defalias 'ement-room-describe #'ement-describe-room)\n\n;;;;;; Push rules\n\n;; NOTE: Although v1.4 of the spec is available and describes setting the push rules using\n;; the \"v3\" API endpoint, the Element client continues to use the \"r0\" endpoint, which is\n;; slightly different. This implementation will follow Element's initially, because the\n;; spec is not simple, and imitating Element's requests will make it easier.\n\n(defun ement-room-notification-state (room session)\n \"Return notification state for ROOM on SESSION.\nReturns one of nil (meaning default rules are used), `all-loud',\n`all', `mentions-and-keywords', or `none'.\"\n ;; Following the implementation of getRoomNotifsState() in RoomNotifs.ts in matrix-react-sdk.\n\n ;; TODO: Guest support (in which case the state should be `all').\n ;; TODO: Store account data as a hash table of event types.\n (let ((push-rules (cl-find-if (lambda (alist)\n (equal \"m.push_rules\" (alist-get 'type alist)))\n (ement-session-account-data session))))\n (cl-labels ((override-mute-rule-for-room-p\n ;; Following findOverrideMuteRule() in RoomNotifs.ts.\n (room) (when-let ((overrides (map-nested-elt push-rules '(content global override))))\n (cl-loop for rule in overrides\n when (and (alist-get 'enabled rule)\n (rule-for-room-p rule room))\n return rule)))\n (rule-for-room-p\n ;; Following isRuleForRoom() in RoomNotifs.ts.\n (rule room) (and (/= 1 (length (alist-get 'conditions rule)))\n (pcase-let* ((condition (elt (alist-get 'conditions rule) 0))\n ((map kind key pattern) condition))\n (and (equal \"event_match\" kind)\n (equal \"room_id\" key)\n (equal (ement-room-id room) pattern)))))\n (mute-rule-p\n (rule) (and (= 1 (length (alist-get 'actions rule)))\n (equal \"dont_notify\" (elt (alist-get 'actions rule) 0))))\n (tweak-rule-p\n (type rule) (pcase-let (((map ('actions `[,action ,alist])) rule))\n (and (equal \"notify\" action)\n (equal type (alist-get 'set_tweak alist))))))\n ;; If none of these match, nil is returned, meaning that the default rule is used\n ;; for the room.\n (if (override-mute-rule-for-room-p room)\n 'none\n (when-let ((room-rule (cl-find-if (lambda (rule)\n (equal (ement-room-id room) (alist-get 'rule_id rule)))\n (map-nested-elt push-rules '(content global room)))))\n (cond ((not (alist-get 'enabled room-rule))\n ;; NOTE: According to comment in getRoomNotifsState(), this assumes that\n ;; the default is to notify for all messages, which \"will be 'wrong' for\n ;; one to one rooms because they will notify loudly for all messages.\"\n 'all)\n ((mute-rule-p room-rule)\n ;; According to comment, a room-level mute still allows mentions to\n ;; notify.\n 'mentions-and-keywords)\n ((tweak-rule-p \"sound\" room-rule) 'all-loud)))))))\n\n(defun ement-room-set-notification-state (state room session)\n \"Set notification STATE for ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room. STATE may be nil to set the rules to\ndefault, `all', `mentions-and-keywords', or `none'.\"\n ;; This merely attempts to reproduce the behavior of Element's simple notification\n ;; options. It does not attempt to offer all of the features defined in the spec. And,\n ;; yes, it is rather awkward, having to sometimes* make multiple requests of different\n ;; \"kinds\" to set the rules for a single room, but that is how the API works.\n ;;\n ;; * It appears that Element only makes multiple requests of different kinds when\n ;; strictly necessary, but coding that logic now would seem likely to be a waste of\n ;; time, given that Element doesn't even use the latest version of the spec yet. So\n ;; we'll just do the \"dumb\" thing and always send requests of both \"override\" and\n ;; \"room\" kinds, which appears to Just Work™.\n ;;\n ;; TODO: Match rules to these user-friendly notification states for presentation. See\n ;; .\n\n ;; TODO: Support `all-loud' (\"all_messages_loud\").\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Set notification rules for %s: \" (ement--format-room ement-room)))\n (available-states (ement-alist \"Default\" nil\n \"All messages\" 'all\n \"Mentions and keywords\" 'mentions-and-keywords\n \"None\" 'none))\n (selected-rule (completing-read prompt (mapcar #'car available-states) nil t))\n (state (alist-get selected-rule available-states nil nil #'equal)))\n (list state ement-room ement-session))))\n (cl-labels ((set-rule (kind rule queue message-fn)\n (pcase-let* (((cl-struct ement-room (id room-id)) room)\n (rule-id (url-hexify-string room-id))\n (endpoint (format \"pushrules/global/%s/%s\" kind rule-id))\n (method (if rule 'put 'delete))\n (then (if rule\n ;; Setting rules requires PUTting the rules, then making a second\n ;; request to enable them.\n (lambda (_data)\n (ement-api session (concat endpoint \"/enabled\") :queue queue :version \"r0\"\n :method 'put :data (json-encode (ement-alist 'enabled t))\n :then message-fn))\n message-fn)))\n (ement-api session endpoint :queue queue :method method :version \"r0\"\n :data (json-encode rule)\n :then then\n :else (lambda (plz-error)\n (pcase-let* (((cl-struct plz-error response) plz-error)\n ((cl-struct plz-response status) response))\n (pcase status\n (404 (pcase rule\n (`nil\n ;; Room already had no rules, so none being found is not an\n ;; error.\n nil)\n (_ ;; Unexpected error: re-signal.\n (ement-api-error plz-error))))\n (_ ;; Unexpected error: re-signal.\n (ement-api-error plz-error)))))))))\n (pcase-let* ((available-states\n (ement-alist\n nil (ement-alist\n \"override\" nil\n \"room\" nil)\n 'all (ement-alist\n \"override\" nil\n \"room\" (ement-alist\n 'actions (vector \"notify\" (ement-alist\n 'set_tweak \"sound\"\n 'value \"default\"))))\n 'mentions-and-keywords (ement-alist\n \"override\" nil\n \"room\" (ement-alist\n 'actions (vector \"dont_notify\")))\n 'none (ement-alist\n \"override\" (ement-alist\n 'actions (vector \"dont_notify\")\n 'conditions (vector (ement-alist\n 'kind \"event_match\"\n 'key \"room_id\"\n 'pattern (ement-room-id room))))\n \"room\" nil)))\n (kinds-and-rules (alist-get state available-states nil nil #'equal)))\n (cl-loop with queue = (make-plz-queue :limit 1)\n with total = (1- (length kinds-and-rules))\n for count from 0\n for message-fn = (if (equal count total)\n (lambda (_data)\n (message \"Set notification rules for room: %s\" (ement--format-room room)))\n #'ignore)\n for (kind . state) in kinds-and-rules\n do (set-rule kind state queue message-fn)))))\n\n;;;;; Public functions\n\n;; These functions could reasonably be called by code in other packages.\n\n(cl-defun ement-put-state\n (room type key data session\n &key (then (lambda (response-data)\n (ement-debug \"State data put on room\" response-data data room session))))\n \"Put state event of TYPE with KEY and DATA on ROOM on SESSION.\nDATA should be an alist, which will become the JSON request\nbody.\"\n (declare (indent defun))\n (pcase-let* ((endpoint (format \"rooms/%s/state/%s/%s\"\n (url-hexify-string (ement-room-id room))\n type key)))\n (ement-api session endpoint :method 'put :data (json-encode data)\n ;; TODO: Handle error codes.\n :then then)))\n\n(defun ement-message (format-string &rest args)\n \"Call `message' on FORMAT-STRING prefixed with \\\"Ement: \\\".\"\n ;; TODO: Use this function everywhere we use `message'.\n (apply #'message (concat \"Ement: \" format-string) args))\n\n(cl-defun ement-upload (session &key data filename then else\n (content-type \"application/octet-stream\"))\n \"Upload DATA with FILENAME to content repository on SESSION.\nTHEN and ELSE are passed to `ement-api', which see.\"\n (declare (indent defun))\n (ement-api session \"upload\" :method 'post :endpoint-category \"media\"\n ;; NOTE: Element currently uses \"r0\" not \"v3\", so so do we.\n :params (when filename\n (list (list \"filename\" filename)))\n :content-type content-type :data data :data-type 'binary\n :then then :else else))\n\n(cl-defun ement-complete-session (&key (prompt \"Session: \"))\n \"Return an Ement session selected with completion.\"\n (cl-etypecase (length ement-sessions)\n ((integer 1 1) (cdar ement-sessions))\n ((integer 2 *) (let* ((ids (mapcar #'car ement-sessions))\n (selected-id (completing-read prompt ids nil t)))\n (alist-get selected-id ement-sessions nil nil #'equal)))\n (otherwise (user-error \"No active sessions. Call `ement-connect' to log in\"))))\n\n(declare-function ewoc-locate \"ewoc\")\n(defun ement-complete-user-id ()\n \"Return a user-id selected with completion.\nSelects from seen users on all sessions. If point is on an\nevent, suggests the event's sender as initial input. Allows\nunseen user IDs to be input as well.\"\n (cl-labels ((format-user (user)\n ;; FIXME: Per-room displaynames are now stored in room structs\n ;; rather than user structs, so to be complete, this needs to\n ;; iterate over all known rooms, looking for the user's\n ;; displayname in that room.\n (format \"%s <%s>\"\n (ement-user-displayname user)\n\t\t\t\t (ement-user-id user))))\n (let* ((display-to-id\n\t (cl-loop for key being the hash-keys of ement-users\n\t\t using (hash-values value)\n\t\t collect (cons (format-user value) key)))\n (user-at-point (when (equal major-mode 'ement-room-mode)\n (when-let ((node (ewoc-locate ement-ewoc)))\n (when (ement-event-p (ewoc-data node))\n (format-user (ement-event-sender (ewoc-data node)))))))\n\t (selected-user (completing-read \"User: \" (mapcar #'car display-to-id)\n nil nil user-at-point)))\n (or (alist-get selected-user display-to-id nil nil #'equal)\n\t selected-user))))\n\n(cl-defun ement-put-account-data\n (session type data &key room\n (then (lambda (received-data)\n ;; Handle echoed-back account data event (the spec does not explain this,\n ;; but see ).\n ;; FIXME: Make session account-data a map instead of a list of events.\n (if room\n (push received-data (ement-room-account-data room))\n (push received-data (ement-session-account-data session)))\n\n ;; NOTE: Commenting out this ement-debug form because a bug in Emacs\n ;; causes this long string to be interpreted as the function's\n ;; docstring and cause a too-long-docstring warning.\n\n ;; (ement-debug \"Account data put and received back on session %s: PUT(json-encoded):%S RECEIVED:%S\"\n ;; (ement-user-id (ement-session-user session)) (json-encode data) received-data)\n )))\n \"Put account data of TYPE with DATA on SESSION.\nIf ROOM, put it on that room's account data. Also handle the\nechoed-back event.\"\n (declare (indent defun))\n (pcase-let* (((cl-struct ement-session (user (cl-struct ement-user (id user-id)))) session)\n (room-part (if room (format \"/rooms/%s\" (ement-room-id room)) \"\"))\n (endpoint (format \"user/%s%s/account_data/%s\" (url-hexify-string user-id) room-part type)))\n (ement-api session endpoint :method 'put :data (json-encode data)\n :then then)))\n\n(defun ement-redact (event room session &optional reason)\n \"Redact EVENT in ROOM on SESSION, optionally for REASON.\"\n (pcase-let* (((cl-struct ement-event (id event-id)) event)\n ((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"rooms/%s/redact/%s/%s\"\n room-id event-id (ement--update-transaction-id session)))\n (content (ement-alist \"reason\" reason)))\n (ement-api session endpoint :method 'put :data (json-encode content)\n :then (lambda (_data)\n (message \"Event %s redacted.\" event-id)))))\n\n;;;;; Inline functions\n\n(defsubst ement--user-color (user)\n \"Return USER's color, setting it if necessary.\nUSER is an `ement-user' struct.\"\n (or (ement-user-color user)\n (setf (ement-user-color user)\n (ement--prism-color (ement-user-id user)))))\n\n;;;;; Private functions\n\n;; These functions aren't expected to be called by code in other packages (but if that\n;; were necessary, they could be renamed accordingly).\n\n;; (defun ement--room-routing (room)\n;; \"Return a list of servers to route to ROOM through.\"\n;; ;; See .\n;; ;; FIXME: Ensure highest power level user is at least level 50.\n;; ;; FIXME: Ignore servers blocked due to server ACLs.\n;; ;; FIXME: Ignore servers which are IP addresses.\n;; (cl-labels ((most-powerful-user-in\n;; (room))\n;; (servers-by-population-in\n;; (room))\n;; (server-of (user)))\n;; (let (first-server-by-power-level)\n;; (delete-dups\n;; (remq nil\n;; (list\n;; ;; 1.\n;; (or (when-let ((user (most-powerful-user-in room)))\n;; (setf first-server-by-power-level t)\n;; (server-of user))\n;; (car (servers-by-population-in room)))\n;; ;; 2.\n;; (if first-server-by-power-level\n;; (car (servers-by-population-in room))\n;; (cl-second (servers-by-population-in room)))\n;; ;; 3.\n;; (cl-third (servers-by-population-in room))))))))\n\n(defun ement--room-space-p (room)\n \"Return non-nil if ROOM is a space.\"\n (equal \"m.space\" (ement-room-type room)))\n\n(defun ement--room-in-space-p (room space)\n \"Return non-nil if ROOM is in SPACE on SESSION.\"\n ;; We could use `ement---room-spaces', but since that returns rooms by looking them up\n ;; by ID in the session's rooms list, this is more efficient.\n (pcase-let* (((cl-struct ement-room (id parent-id) (local (map children))) space)\n ((cl-struct ement-room (id child-id) (local (map parents))) room))\n (or (member parent-id parents)\n (member child-id children))))\n\n(defun ement--room-spaces (room session)\n \"Return list of ROOM's parent spaces on SESSION.\"\n ;; NOTE: This only looks in the room's parents list; it doesn't look in every space's children\n ;; list. This should be good enough, assuming we add to the lists correctly elsewhere.\n (pcase-let* (((cl-struct ement-session rooms) session)\n ((cl-struct ement-room (local (map parents))) room))\n (cl-remove-if-not (lambda (session-room-id)\n (member session-room-id parents))\n rooms :key #'ement-room-id)))\n\n(cl-defun ement--prism-color (string &key (contrast-with (face-background 'default nil 'default)))\n \"Return a computed color for STRING.\nThe color is adjusted to have sufficient contrast with the color\nCONTRAST-WITH (by default, the default face's background). The\ncomputed color is useful for user messages, generated room\navatars, etc.\"\n ;; TODO: Use this instead of `ement-room--user-color'. (Same algorithm ,just takes a\n ;; string as argument.)\n ;; TODO: Try using HSV somehow so we could avoid having so many strings return a\n ;; nearly-black color.\n (cl-labels ((relative-luminance\n ;; Copy of `modus-themes-wcag-formula', an elegant\n ;; implementation by Protesilaos Stavrou. Also see\n ;; and\n ;; .\n (rgb) (cl-loop for k in '(0.2126 0.7152 0.0722)\n for x in rgb\n sum (* k (if (<= x 0.03928)\n (/ x 12.92)\n (expt (/ (+ x 0.055) 1.055) 2.4)))))\n (contrast-ratio\n ;; Copy of `modus-themes-contrast'; see above.\n (a b) (let ((ct (/ (+ (relative-luminance a) 0.05)\n (+ (relative-luminance b) 0.05))))\n (max ct (/ ct))))\n (increase-contrast\n (color against target toward)\n (let ((gradient (cdr (color-gradient color toward 20)))\n new-color)\n (cl-loop do (setf new-color (pop gradient))\n while new-color\n until (>= (contrast-ratio new-color against) target)\n ;; Avoid infinite loop in case of weirdness\n ;; by returning color as a fallback.\n finally return (or new-color color)))))\n (let* ((id string)\n (id-hash (float (+ (abs (sxhash id)) ement-room-prism-color-adjustment)))\n ;; TODO: Wrap-around the value to get the color I want.\n (ratio (/ id-hash (float most-positive-fixnum)))\n (color-num (round (* (* 255 255 255) ratio)))\n (color-rgb (list (/ (float (logand color-num 255)) 255)\n (/ (float (lsh (logand color-num 65280) -8)) 255)\n (/ (float (lsh (logand color-num 16711680) -16)) 255)))\n (contrast-with-rgb (color-name-to-rgb contrast-with)))\n (when (< (contrast-ratio color-rgb contrast-with-rgb) ement-room-prism-minimum-contrast)\n (setf color-rgb (increase-contrast color-rgb contrast-with-rgb ement-room-prism-minimum-contrast\n (color-name-to-rgb\n ;; Ideally we would use the foreground color,\n ;; but in some themes, like Solarized Dark,\n ;; the foreground color's contrast is too low\n ;; to be effective as the value to increase\n ;; contrast against, so we use white or black.\n (pcase contrast-with\n ((or `nil \"unspecified-bg\")\n ;; The `contrast-with' color (i.e. the\n ;; default background color) is nil. This\n ;; probably means that we're displaying on\n ;; a TTY.\n (if (fboundp 'frame--current-backround-mode)\n ;; This function can tell us whether\n ;; the background color is dark or\n ;; light, but it was added in Emacs\n ;; 28.1.\n (pcase (frame--current-backround-mode (selected-frame))\n ('dark \"white\")\n ('light \"black\"))\n ;; Pre-28.1: Since faces' colors may be\n ;; \"unspecified\" on TTY frames, in which\n ;; case we have nothing to compare with, we\n ;; assume that the background color of such\n ;; a frame is black and increase contrast\n ;; toward white.\n \"white\"))\n (_\n ;; The `contrast-with` color is usable: test it.\n (if (ement--color-dark-p (color-name-to-rgb contrast-with))\n \"white\" \"black\")))))))\n (apply #'color-rgb-to-hex (append color-rgb (list 2))))))\n\n(cl-defun ement--format-user (user &optional (room ement-room) (session ement-session))\n \"Format `ement-user' USER for ROOM on SESSION.\nROOM defaults to the value of `ement-room'.\"\n (let ((face (cond ((equal (ement-user-id (ement-session-user session))\n (ement-user-id user))\n 'ement-room-self)\n (ement-room-prism\n `(:inherit ement-room-user :foreground ,(or (ement-user-color user)\n (setf (ement-user-color user)\n (ement--prism-color user)))))\n (t 'ement-room-user))))\n ;; FIXME: If a membership state event has not yet been received, this\n ;; sets the display name in the room to the user ID, and that prevents\n ;; the display name from being used if the state event arrives later.\n (propertize (ement--user-displayname-in room user)\n 'face face\n 'help-echo (ement-user-id user))))\n\n(cl-defun ement--format-body-mentions\n (body room &key (template \"%s\"))\n \"Return string for BODY with mentions in ROOM linkified with TEMPLATE.\nTEMPLATE is a format string in which the first \\\"%s\\\" is replaced\nwith the user's MXID and the second with the displayname. A\nmention is qualified by an \\\"@\\\"-prefixed displayname or\nMXID (optionally suffixed with a colon), or a colon-suffixed\ndisplayname, followed by a blank, question mark, comma, or\nperiod, anywhere in the body.\"\n ;; Examples:\n ;; \"@foo: hi\"\n ;; \"@foo:matrix.org: hi\"\n ;; \"foo: hi\"\n ;; \"@foo and @bar:matrix.org: hi\"\n ;; \"foo: how about you and @bar ...\"\n (declare (indent defun))\n (cl-labels ((members-having-displayname\n ;; Iterating over the hash table values isn't as efficient as a hash\n ;; lookup, but in most rooms it shouldn't be a problem.\n (name members) (cl-loop for user being the hash-values of members\n when (equal name (ement--user-displayname-in room user))\n collect user)))\n (pcase-let* (((cl-struct ement-room members) room)\n (regexp (rx (or bos bow (1+ blank))\n (or (seq (group\n ;; Group 1: full @-prefixed MXID.\n \"@\" (group\n ;; Group 2: displayname. (NOTE: Does not work\n ;; with displaynames containing spaces.)\n (1+ (seq (optional \".\") alnum)))\n (optional \":\" (1+ (seq (optional \".\") alnum))))\n (or \":\" eow eos (syntax punctuation)))\n (seq (group\n ;; Group 3: MXID username or displayname.\n (1+ (not blank)))\n \":\" (1+ blank)))))\n (pos 0) (replace-group) (replacement))\n (while (setf pos (string-match regexp body pos))\n (if (setf replacement\n (or (when-let (member (gethash (match-string 1 body) members))\n ;; Found user ID: use it as replacement.\n (setf replace-group 1)\n (format template (match-string 1 body)\n (ement--xml-escape-string (ement--user-displayname-in room member))))\n (when-let* ((name (or (when (match-string 2 body)\n (setf replace-group 1)\n (match-string 2 body))\n (prog1 (match-string 3 body)\n (setf replace-group 3))))\n (members (members-having-displayname name members))\n (member (when (= 1 (length members))\n ;; If multiple members are found with the same\n ;; displayname, do nothing.\n (car members))))\n ;; Found displayname: use it and MXID as replacement.\n (format template (ement-user-id member)\n (ement--xml-escape-string name)))))\n (progn\n ;; Found member: replace and move to end of replacement.\n (setf body (replace-match replacement t t body replace-group))\n (let ((difference (- (length replacement) (length (match-string 0 body)))))\n (setf pos (if (/= 0 difference)\n ;; Replacement of a different length: adjust POS accordingly.\n (+ pos difference)\n (match-end 0)))))\n ;; No replacement: move to end of match.\n (setf pos (match-end 0))))))\n body)\n\n(defun ement--event-mentions-room-p (event &rest _ignore)\n \"Return non-nil if EVENT mentions \\\"@room\\\".\"\n (pcase-let (((cl-struct ement-event (content (map body))) event))\n (when body\n (string-match-p (rx (or space bos) \"@room\" eow) body))))\n\n(cl-defun ement-complete-room (&key session (predicate #'identity)\n (prompt \"Room: \") (suggest t))\n \"Return a (room session) list selected from SESSION with completion.\nIf SESSION is nil, select from rooms in all of `ement-sessions'.\nWhen SUGGEST, suggest current buffer's room (or a room at point\nin a room list buffer) as initial input (i.e. it should be set to\nnil when switching from one room buffer to another). PROMPT may\noverride the default prompt. PREDICATE may be a function to\nselect which rooms are offered; it is also applied to the\nsuggested room.\"\n (declare (indent defun))\n (pcase-let* ((sessions (if session\n (list session)\n (mapcar #'cdr ement-sessions)))\n (name-to-room-session\n (cl-loop for session in sessions\n append (cl-loop for room in (ement-session-rooms session)\n when (funcall predicate room)\n collect (cons (ement--format-room room 'topic)\n (list room session)))))\n (names (mapcar #'car name-to-room-session))\n (selected-name (completing-read\n prompt names nil t\n (when suggest\n (when-let ((suggestion (ement--room-at-point)))\n (when (or (not predicate)\n (funcall predicate suggestion))\n (ement--format-room suggestion 'topic)))))))\n (alist-get selected-name name-to-room-session nil nil #'string=)))\n\n(cl-defun ement-send-message (room session\n &key body formatted-body replying-to-event filter then)\n \"Send message to ROOM on SESSION with BODY and FORMATTED-BODY.\nTHEN may be a function to call after the event is sent\nsuccessfully. It is called with keyword arguments for ROOM,\nSESSION, CONTENT, and DATA.\n\nREPLYING-TO-EVENT may be an event the message is\nin reply to; the message will reference it appropriately.\n\nFILTER may be a function through which to pass the message's\ncontent object before sending (see,\ne.g. `ement-room-send-org-filter').\"\n (declare (indent defun))\n (cl-assert (not (string-empty-p body)))\n (cl-assert (or (not formatted-body) (not (string-empty-p formatted-body))))\n (pcase-let* (((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"rooms/%s/send/m.room.message/%s\" (url-hexify-string room-id)\n (ement--update-transaction-id session)))\n (formatted-body (when formatted-body\n (ement--format-body-mentions formatted-body room)))\n (content (ement-aprog1\n (ement-alist \"msgtype\" \"m.text\"\n \"body\" body)\n (when formatted-body\n (push (cons \"formatted_body\" formatted-body) it)\n (push (cons \"format\" \"org.matrix.custom.html\") it))))\n (then (or then #'ignore)))\n (when filter\n (setf content (funcall filter content room)))\n (when replying-to-event\n (setf content (ement--add-reply content replying-to-event room)))\n (ement-api session endpoint :method 'put :data (json-encode content)\n :then (apply-partially then :room room :session session\n ;; Data is added when calling back.\n :content content :data))))\n\n(defalias 'ement--button-buttonize\n ;; FIXME: This doesn't set the mouse-face to highlight, and it doesn't use the\n ;; default-button category. Neither does `button-buttonize', of course, but why?\n (if (version< emacs-version \"28.1\")\n (lambda (string callback &optional data)\n \"Make STRING into a button and return it.\nWhen clicked, CALLBACK will be called with the DATA as the\nfunction argument. If DATA isn't present (or is nil), the button\nitself will be used instead as the function argument.\"\n (propertize string\n 'face 'button\n 'button t\n 'follow-link t\n 'category t\n 'button-data data\n 'keymap button-map\n 'action callback))\n #'button-buttonize))\n\n(defun ement--add-reply (data replying-to-event room)\n \"Return DATA adding reply data for REPLYING-TO-EVENT in ROOM.\nDATA is an unsent message event's data alist.\"\n ;; SPEC: \"13.2.2.6.1 Rich replies\"\n ;; FIXME: Rename DATA.\n (pcase-let* (((cl-struct ement-event (id replying-to-event-id)\n content (sender replying-to-sender))\n replying-to-event)\n ((cl-struct ement-user (id replying-to-sender-id)) replying-to-sender)\n ((map ('body replying-to-body) ('formatted_body replying-to-formatted-body)) content)\n (replying-to-sender-name (ement--user-displayname-in ement-room replying-to-sender))\n (quote-string (format \"> <%s> %s\\n\\n\" replying-to-sender-name replying-to-body))\n (reply-body (alist-get \"body\" data nil nil #'string=))\n (reply-formatted-body (alist-get \"formatted_body\" data nil nil #'string=))\n (reply-body-with-quote (concat quote-string reply-body))\n (reply-formatted-body-with-quote\n (format \"\n

\n In reply to\n %s\n
\n %s\n

\n\n%s\"\n (ement-room-id room) replying-to-event-id replying-to-sender-id replying-to-sender-name\n ;; TODO: Encode HTML special characters. Not as straightforward in Emacs as one\n ;; might hope: there's `web-mode-html-entities' and `org-entities'. See also\n ;; .\n (or replying-to-formatted-body replying-to-body)\n (or reply-formatted-body reply-body))))\n ;; NOTE: map-elt doesn't work with string keys, so we use `alist-get'.\n (setf (alist-get \"body\" data nil nil #'string=) reply-body-with-quote\n (alist-get \"formatted_body\" data nil nil #'string=) reply-formatted-body-with-quote\n data (append (ement-alist \"m.relates_to\"\n (ement-alist \"m.in_reply_to\"\n (ement-alist \"event_id\" replying-to-event-id))\n \"format\" \"org.matrix.custom.html\")\n data))\n data))\n\n(defun ement--direct-room-for-user (user session)\n \"Return last-modified direct room with USER on SESSION, if one exists.\"\n ;; Loosely modeled on the Element function findDMForUser in createRoom.ts.\n (cl-labels ((membership-event-for-p\n (event user) (and (equal \"m.room.member\" (ement-event-type event))\n (equal (ement-user-id user) (ement-event-state-key event))))\n (latest-membership-for\n (user room)\n (when-let ((latest-membership-event\n (car\n (cl-sort\n ;; I guess we need to check both state and timeline events.\n (append (cl-remove-if-not (lambda (event)\n (membership-event-for-p event user))\n (ement-room-state room))\n (cl-remove-if-not (lambda (event)\n (membership-event-for-p event user))\n (ement-room-timeline room)))\n (lambda (a b)\n ;; Sort latest first so we can use the car.\n (> (ement-event-origin-server-ts a)\n (ement-event-origin-server-ts b)))))))\n (alist-get 'membership (ement-event-content latest-membership-event))))\n (latest-event-in\n (room) (car\n (cl-sort\n (append (ement-room-state room)\n (ement-room-timeline room))\n (lambda (a b)\n ;; Sort latest first so we can use the car.\n (> (ement-event-origin-server-ts a)\n (ement-event-origin-server-ts b)))))))\n (let* ((direct-rooms (cl-remove-if-not\n (lambda (room)\n (ement--room-direct-p room session))\n (ement-session-rooms session)))\n (direct-joined-rooms\n ;; Ensure that the local user is still in each room.\n (cl-remove-if-not\n (lambda (room)\n (equal \"join\" (latest-membership-for (ement-session-user session) room)))\n direct-rooms))\n ;; Since we don't currently keep a member list for each room, we look in the room's\n ;; join events to see if the user has joined or been invited.\n (direct-rooms-with-user\n (cl-remove-if-not\n (lambda (room)\n (member (latest-membership-for user room) '(\"invite\" \"join\")))\n direct-joined-rooms)))\n (car (cl-sort direct-rooms-with-user\n (lambda (a b)\n (> (latest-event-in a) (latest-event-in b))))))))\n\n(defun ement--event-replaces-p (a b)\n \"Return non-nil if event A replaces event B.\nThat is, if event A replaces B in their\n\\\"m.relates_to\\\"/\\\"m.relations\\\" and \\\"m.replace\\\" metadata.\"\n (pcase-let* (((cl-struct ement-event (id a-id)\n (content (map ('m.relates_to\n (map ('rel_type a-rel-type)\n ('event_id a-replaces-event-id))))))\n a)\n ((cl-struct ement-event (id b-id)\n ;; Not sure why this ends up in the unsigned key, but it does.\n (unsigned (map ('m.relations\n (map ('m.replace\n (map ('event_id b-replaced-by-event-id))))))))\n b))\n (or (and (equal \"m.replace\" a-rel-type)\n (equal a-replaces-event-id b-id))\n (equal a-id b-replaced-by-event-id))))\n\n(defun ement--events-equal-p (a b)\n \"Return non-nil if events A and B are essentially equal.\nThat is, A and B are either the same event (having the same event\nID), or one event replaces the other (in their m.relates_to and\nm.replace metadata).\"\n (or (equal (ement-event-id a) (ement-event-id b))\n (ement--event-replaces-p a b)\n (ement--event-replaces-p b a)))\n\n(defun ement--format-room (room &optional topic)\n \"Return ROOM formatted with name, alias, ID, and optionally TOPIC.\nSuitable for use in completion, etc.\"\n (if topic\n (format \"%s%s(<%s>)%s\"\n (or (ement-room-display-name room)\n (setf (ement-room-display-name room)\n (ement--room-display-name room)))\n (if (ement-room-canonical-alias room)\n (format \" <%s> \" (ement-room-canonical-alias room))\n \" \")\n (ement-room-id room)\n (if (ement-room-topic room)\n (format \": \\\"%s\\\"\" (ement-room-topic room))\n \"\"))\n (format \"%s%s(<%s>)\"\n (or (ement-room-display-name room)\n (setf (ement-room-display-name room)\n (ement--room-display-name room)))\n (if (ement-room-canonical-alias room)\n (format \" <%s> \" (ement-room-canonical-alias room))\n \" \")\n (ement-room-id room))))\n\n(defun ement--members-alist (room)\n \"Return alist of member displaynames mapped to IDs seen in ROOM.\"\n ;; We map displaynames to IDs because `ement-room--format-body-mentions' needs to find\n ;; MXIDs from displaynames.\n (pcase-let* (((cl-struct ement-room timeline) room)\n (members-seen (mapcar #'ement-event-sender timeline))\n (members-alist))\n (dolist (member members-seen)\n ;; Testing with `benchmark-run-compiled', it appears that using `cl-pushnew' is\n ;; about 10x faster than using `delete-dups'.\n (cl-pushnew (cons (ement--user-displayname-in room member)\n (ement-user-id member))\n members-alist))\n members-alist))\n\n(defun ement--mxc-to-url (uri session)\n \"Return HTTPS URL for MXC URI accessed through SESSION.\"\n (pcase-let* (((cl-struct ement-session server) session)\n ((cl-struct ement-server uri-prefix) server)\n (server-name) (media-id))\n (string-match (rx \"mxc://\" (group (1+ (not (any \"/\"))))\n \"/\" (group (1+ anything))) uri)\n (setf server-name (match-string 1 uri)\n media-id (match-string 2 uri))\n (format \"%s/_matrix/media/r0/download/%s/%s\"\n uri-prefix server-name media-id)))\n\n(defun ement--remove-face-property (string value)\n \"Remove VALUE from STRING's `face' properties.\nUsed to remove the `button' face from buttons, because that face\ncan cause undesirable underlining.\"\n (let ((pos 0))\n (cl-loop for next-face-change-pos = (next-single-property-change pos 'face string)\n for face-at = (get-text-property pos 'face string)\n when face-at\n do (put-text-property pos (or next-face-change-pos (length string))\n 'face (cl-typecase face-at\n (atom (if (equal value face-at)\n nil face-at))\n (list (remove value face-at)))\n string)\n while next-face-change-pos\n do (setf pos next-face-change-pos))))\n\n(defun ement--resize-image (image max-width max-height)\n \"Return a copy of IMAGE set to MAX-WIDTH and MAX-HEIGHT.\nIMAGE should be one as created by, e.g. `create-image'.\"\n ;; It would be nice if the image library had some simple functions to do this sort of thing.\n (let ((new-image (cl-copy-list image)))\n (when (fboundp 'imagemagick-types)\n ;; Only do this when ImageMagick is supported.\n ;; FIXME: When requiring Emacs 27+, remove this (I guess?).\n (setf (image-property new-image :type) 'imagemagick))\n (setf (image-property new-image :max-width) max-width\n (image-property new-image :max-height) max-height)\n new-image))\n\n(defun ement--room-alias (room)\n \"Return latest m.room.canonical_alias event in ROOM.\"\n ;; FIXME: This function probably needs to compare timestamps to ensure that older events\n ;; that are inserted at the head of the events lists aren't used instead of newer ones.\n (or (cl-loop for event in (ement-room-timeline room)\n when (equal \"m.room.canonical_alias\" (ement-event-type event))\n return (alist-get 'alias (ement-event-content event)))\n (cl-loop for event in (ement-room-state room)\n when (equal \"m.room.canonical_alias\" (ement-event-type event))\n return (alist-get 'alias (ement-event-content event)))))\n\n(declare-function magit-current-section \"magit-section\")\n(declare-function eieio-oref \"eieio-core\")\n(defun ement--room-at-point ()\n \"Return room at point.\nWorks in major-modes `ement-room-mode',\n`ement-tabulated-room-list-mode', and `ement-room-list-mode'.\"\n (pcase major-mode\n ('ement-room-mode ement-room)\n ('ement-tabulated-room-list-mode (tabulated-list-get-id))\n ('ement-room-list-mode\n (cl-typecase (oref (magit-current-section) value)\n (taxy-magit-section nil)\n (t (pcase (oref (magit-current-section) value)\n (`[,room ,_session] room)))))))\n\n(defun ement--room-direct-p (room session)\n \"Return non-nil if ROOM on SESSION is a direct chat.\"\n (cl-labels ((content-contains-room-id\n (content room-id) (cl-loop for (_user-id . room-ids) in content\n ;; NOTE: room-ids is a vector.\n thereis (seq-contains-p room-ids room-id))))\n (pcase-let* (((cl-struct ement-session account-data) session)\n ((cl-struct ement-room id) room))\n (or (cl-loop for event in account-data\n when (equal \"m.direct\" (alist-get 'type event))\n thereis (content-contains-room-id (alist-get 'content event) id))\n (cl-loop\n ;; Invited rooms have no account-data yet, and their\n ;; directness flag is in invite-state events.\n for event in (ement-room-invite-state room)\n thereis (alist-get 'is_direct (ement-event-content event)))))))\n\n(defun ement--room-display-name (room)\n \"Return the displayname for ROOM.\"\n ;; SPEC: .\n ;; NOTE: The spec seems incomplete, because the algorithm it recommends does not say how\n ;; or when to use \"m.room.member\" events for rooms without heroes (e.g. invited rooms).\n ;; TODO: Add SESSION argument and use it to remove local user from names.\n (cl-labels ((latest-event (type content-field)\n (or (cl-loop for event in (ement-room-timeline room)\n when (and (equal type (ement-event-type event))\n (not (string-empty-p (alist-get content-field (ement-event-content event)))))\n return (alist-get content-field (ement-event-content event)))\n (cl-loop for event in (ement-room-state room)\n when (and (equal type (ement-event-type event))\n (not (string-empty-p (alist-get content-field (ement-event-content event)))))\n return (alist-get content-field (ement-event-content event)))))\n (member-events-name\n () (when-let ((member-events (cl-loop for accessor in '(ement-room-timeline ement-room-state ement-room-invite-state)\n append (cl-remove-if-not (apply-partially #'equal \"m.room.member\")\n (funcall accessor room)\n :key #'ement-event-type))))\n (string-join (delete-dups\n (mapcar (lambda (event)\n (ement--user-displayname-in room (ement-event-sender event)))\n member-events))\n \", \")))\n (heroes-name\n () (pcase-let* (((cl-struct ement-room summary) room)\n ((map ('m.heroes hero-ids) ('m.joined_member_count joined-count)\n ('m.invited_member_count invited-count))\n summary))\n ;; TODO: Disambiguate hero display names.\n (when hero-ids\n (cond ((<= (+ joined-count invited-count) 1)\n ;; Empty room.\n (empty-room hero-ids joined-count))\n ((>= (length hero-ids) (1- (+ joined-count invited-count)))\n ;; Members == heroes.\n (hero-names hero-ids))\n ((and (< (length hero-ids) (1- (+ joined-count invited-count)))\n (> (+ joined-count invited-count) 1))\n ;; More members than heroes.\n (heroes-and-others hero-ids joined-count))))))\n (hero-names\n (heroes) (string-join (mapcar #'hero-name heroes) \", \"))\n (hero-name\n (id) (if-let ((user (gethash id ement-users)))\n (ement--user-displayname-in room user)\n id))\n (heroes-and-others\n (heroes joined)\n (format \"%s, and %s others\" (hero-names heroes)\n (- joined (length heroes))))\n (name-override\n () (when-let ((event (alist-get \"org.matrix.msc3015.m.room.name.override\"\n (ement-room-account-data room)\n nil nil #'equal)))\n (map-nested-elt event '(content name))))\n (empty-room\n (heroes joined) (cl-etypecase (length heroes)\n ((satisfies zerop) \"Empty room\")\n ((number 1 5) (format \"Empty room (was %s)\"\n (hero-names heroes)))\n (t (format \"Empty room (was %s)\"\n (heroes-and-others heroes joined))))))\n (or (name-override)\n (latest-event \"m.room.name\" 'name)\n (latest-event \"m.room.canonical_alias\" 'alias)\n (heroes-name)\n (member-events-name)\n (ement-room-id room))))\n(defun ement--room-favourite-p (room)\n \"Return non-nil if ROOM is tagged as favourite.\"\n (ement--room-tagged-p \"m.favourite\" room))\n\n(defun ement--room-low-priority-p (room)\n \"Return non-nil if ROOM is tagged as low-priority.\"\n (ement--room-tagged-p \"m.lowpriority\" room))\n\n(defun ement--room-tagged-p (tag room)\n \"Return non-nil if ROOM has TAG.\"\n ;; TODO: Use `make-ement-event' on account-data events.\n (pcase-let* (((cl-struct ement-room account-data) room)\n (tag-event (alist-get \"m.tag\" account-data nil nil #'equal)))\n (when tag-event\n (pcase-let (((map ('content (map tags))) tag-event))\n (cl-typecase tag\n ;; Tags are symbols internally, because `json-read' converts map keys to them.\n (string (setf tag (intern tag))))\n (assoc tag tags)))))\n\n(defun ement--room-unread-p (room session)\n \"Return non-nil if ROOM is considered unread for SESSION.\nThe room is unread if it has a modified, live buffer; if it has\nnon-zero unread notification counts; or if its fully-read marker\nis not at the latest known message event.\"\n ;; Roughly equivalent to the \"red/gray/bold/idle\" states listed in\n ;; .\n (pcase-let* (((cl-struct ement-room timeline account-data unread-notifications receipts\n (local (map buffer)))\n room)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-user (id our-id)) user)\n ((map notification_count highlight_count) unread-notifications)\n (fully-read-event-id (map-nested-elt (alist-get \"m.fully_read\" account-data nil nil #'equal)\n '(content event_id))))\n ;; MAYBE: Ignore whether the buffer is modified. Since we have a better handle on how\n ;; Matrix does notifications/unreads/highlights, maybe that's not needed, and it would\n ;; be more consistent to ignore it.\n (or (and buffer (buffer-modified-p buffer))\n (and unread-notifications\n (or (not (zerop notification_count))\n (not (zerop highlight_count))))\n ;; NOTE: This is *WAY* too complicated, but it seems roughly equivalent to doesRoomHaveUnreadMessages() from\n ;; .\n (when (and (not ement-room-unread-only-counts-notifications)\n timeline)\n ;; A room should rarely, if ever, have a nil timeline, but in case it does\n ;; (which apparently can happen, given user reports), it should not be\n ;; considered unread.\n (cl-labels ((event-counts-toward-unread-p\n ;; NOTE: We only consider message events, so membership, reaction,\n ;; etc. events will not mark a room as unread. Ideally, I think\n ;; that join/leave events should, at least optionally, mark a room\n ;; as unread (e.g. in a 1:1 room with a friend, if the other user\n ;; left, one would probably want to know, and marking the room\n ;; unread would help the user notice), but since membership events\n ;; have to be processed to understand their meaning, it's not\n ;; straightforward to know whether one should mark a room unread.\n\n ;; FIXME: Use code from `ement-room--format-member-event' to\n ;; distinguish ones that should count.\n (event) (equal \"m.room.message\" (ement-event-type event))))\n (let ((our-read-receipt-event-id (car (gethash our-id receipts)))\n (first-counting-event (cl-find-if #'event-counts-toward-unread-p timeline)))\n (cond ((equal fully-read-event-id (ement-event-id (car timeline)))\n ;; The fully-read marker is at the last known event: the room is read.\n nil)\n ((and (not our-read-receipt-event-id)\n (when first-counting-event\n (and (not (equal fully-read-event-id (ement-event-id first-counting-event)))\n (not (equal our-id (ement-user-id (ement-event-sender first-counting-event)))))))\n ;; The room has no read receipt, and the latest message event is not\n ;; the event at which our fully-read marker is at, and it is not sent\n ;; by us: the room is unread. (This is a kind of failsafe to ensure\n ;; the user doesn't miss any messages, but it's unclear whether this\n ;; is really correct or best.)\n t)\n ((equal our-id (ement-user-id (ement-event-sender (car timeline))))\n ;; We sent the last event: the room is read.\n nil)\n ((and first-counting-event\n (equal our-id (ement-user-id (ement-event-sender first-counting-event))))\n ;; We sent the last message event: the room is read.\n nil)\n ((cl-loop for event in timeline\n when (event-counts-toward-unread-p event)\n return (and (not (equal our-read-receipt-event-id (ement-event-id event)))\n (not (equal fully-read-event-id (ement-event-id event)))))\n ;; The latest message event is not the event at which our\n ;; read-receipt or fully-read marker are at: the room is unread.\n t))))))))\n\n(defun ement--update-transaction-id (session)\n \"Return SESSION's incremented transaction ID formatted for sending.\nIncrements ID and appends current timestamp to avoid reuse\nproblems.\"\n ;; TODO: Naming things is hard.\n ;; In the event that Emacs isn't killed cleanly and the session isn't saved to disk, the\n ;; transaction ID would get reused the next time the user connects. To avoid that, we\n ;; append the current time to the ID. (IDs are just strings, and Element does something\n ;; similar, so this seems reasonable.)\n (format \"%s-%s\"\n (cl-incf (ement-session-transaction-id session))\n (format-time-string \"%s\")))\n\n(defun ement--user-displayname-in (room user)\n \"Return the displayname for USER in ROOM.\"\n ;; SPEC: .\n ;; FIXME: Add step 3 of the spec. For now we skip to step 4.\n\n ;; NOTE: Both state and timeline events must be searched. (A helpful user\n ;; in #matrix-dev:matrix.org, Michael (t3chguy), clarified this for me).\n (if-let ((cached-name (gethash user (ement-room-displaynames room))))\n cached-name\n ;; Put timeline events before state events, because IIUC they should be more recent.\n (cl-labels ((join-displayname-event-p\n (event) (and (eq user (ement-event-sender event))\n (equal \"m.room.member\" (ement-event-type event))\n (equal \"join\" (alist-get 'membership (ement-event-content event)))\n (alist-get 'displayname (ement-event-content event)))))\n ;; FIXME: Should probably sort the relevant events to get the latest one.\n (if-let* ((displayname (or (cl-loop for event in (ement-room-timeline room)\n when (join-displayname-event-p event)\n return (alist-get 'displayname (ement-event-content event)))\n (cl-loop for event in (ement-room-state room)\n when (join-displayname-event-p event)\n return (alist-get 'displayname (ement-event-content event)))))\n (calculated-name displayname))\n (puthash user calculated-name (ement-room-displaynames room))\n ;; No membership state event: use pre-calculated displayname or ID.\n (or (ement-user-displayname user)\n (ement-user-id user))))))\n\n(defun ement--xml-escape-string (string)\n \"Return STRING having been escaped with `xml-escape-string'.\nBefore Emacs 28, ignores `xml-invalid-character' errors (and any\ninvalid characters cause STRING to remain unescaped). After\nEmacs 28, uses the NOERROR argument to `xml-escape-string'.\"\n (condition-case _\n (xml-escape-string string 'noerror)\n (wrong-number-of-arguments\n (condition-case _\n (xml-escape-string string)\n (xml-invalid-character\n ;; We still don't want to error on this, so just return the string.\n string)))))\n\n(defun ement--mark-room-direct (room session)\n \"Mark ROOM on SESSION as a direct room.\nThis may be used to mark rooms as direct which, for whatever\nreason (like a bug in your favorite client), were not marked as\nsuch when they were created.\"\n (pcase-let* (((cl-struct ement-room timeline (id room-id)) room)\n ((cl-struct ement-session (user local-user)) session)\n ((cl-struct ement-user (id local-user-id)) local-user)\n (direct-rooms-account-data-event-content\n (alist-get 'content\n (cl-find-if (lambda (event)\n (equal \"m.direct\" (alist-get 'type event)))\n (ement-session-account-data session))))\n (members (delete-dups (mapcar #'ement-event-sender timeline)))\n (other-users (cl-remove local-user-id members\n :key #'ement-user-id :test #'equal))\n ((cl-struct ement-user (id other-user-id)) (car other-users))\n ;; The alist keys are MXIDs as symbols.\n (other-user-id (intern other-user-id))\n (existing-direct-rooms-for-user (map-elt direct-rooms-account-data-event-content other-user-id)))\n (cl-assert (= 1 (length other-users)))\n (setf (map-elt direct-rooms-account-data-event-content other-user-id)\n (cl-coerce (append existing-direct-rooms-for-user (list room-id))\n 'vector))\n (ement-put-account-data session \"m.direct\" direct-rooms-account-data-event-content\n :then (lambda (_data)\n (message \"Ement: Room <%s> marked as direct for <%s>.\" room-id other-user-id)))\n (message \"Ement: Marking room as direct...\")))\n\n(cl-defun ement--get-joined-members (room session &key then else)\n \"Get joined members in ROOM on SESSION and call THEN with response data.\nOr call ELSE with error data if request fails. Also puts members\non `ement-users', updating their displayname and avatar URL\nslots, and puts them on ROOM's `members' table.\"\n (declare (indent defun))\n (pcase-let* (((cl-struct ement-room id members) room)\n (endpoint (format \"rooms/%s/joined_members\" (url-hexify-string id))))\n (ement-api session endpoint\n :else else\n :then (lambda (data)\n (clrhash members)\n (mapc (lambda (member)\n (pcase-let* ((`(,id-symbol\n . ,(map ('avatar_url avatar-url)\n ('display_name display-name)))\n member)\n (member-id (symbol-name id-symbol))\n (user (or (gethash member-id ement-users)\n (puthash member-id (make-ement-user :id member-id)\n ement-users))))\n (setf (ement-user-displayname user) display-name\n (ement-user-avatar-url user) avatar-url)\n (puthash member-id user members)))\n (alist-get 'joined data))\n (setf (alist-get 'fetched-members-p (ement-room-local room)) t)\n (when then\n ;; Finally, call the given callback.\n (funcall then data))))\n (message \"Ement: Getting joined members in %s...\" (ement--format-room room))))\n\n(cl-defun ement--human-format-duration (seconds &optional abbreviate)\n \"Return human-formatted string describing duration SECONDS.\nIf SECONDS is less than 1, returns \\\"0 seconds\\\". If ABBREVIATE\nis non-nil, return a shorter version, without spaces. This is a\nsimple calculation that does not account for leap years, leap\nseconds, etc.\"\n ;; Copied from `ts-human-format-duration' (same author).\n (if (< seconds 1)\n (if abbreviate \"0s\" \"0 seconds\")\n (cl-macrolet ((format> (place)\n ;; When PLACE is greater than 0, return formatted string using its symbol name.\n `(when (> ,place 0)\n (format \"%d%s%s\" ,place\n (if abbreviate \"\" \" \")\n (if abbreviate\n ,(substring (symbol-name place) 0 1)\n ,(symbol-name place)))))\n (join-places (&rest places)\n ;; Return string joining the names and values of PLACES.\n `(string-join (delq nil\n (list ,@(cl-loop for place in places\n collect `(format> ,place))))\n (if abbreviate \"\" \", \"))))\n (pcase-let ((`(,years ,days ,hours ,minutes ,seconds) (ement--human-duration seconds)))\n (join-places years days hours minutes seconds)))))\n\n(defun ement--human-duration (seconds)\n \"Return list describing duration SECONDS.\nList includes years, days, hours, minutes, and seconds. This is\na simple calculation that does not account for leap years, leap\nseconds, etc.\"\n ;; Copied from `ts-human-format-duration' (same author).\n (cl-macrolet ((dividef (place divisor)\n ;; Divide PLACE by DIVISOR, set PLACE to the remainder, and return the quotient.\n `(prog1 (/ ,place ,divisor)\n (setf ,place (% ,place ,divisor)))))\n (let* ((seconds (floor seconds))\n (years (dividef seconds 31536000))\n (days (dividef seconds 86400))\n (hours (dividef seconds 3600))\n (minutes (dividef seconds 60)))\n (list years days hours minutes seconds))))\n\n;;; Footer\n\n(provide 'ement-lib)\n\n;;; ement-lib.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-macros.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1931547,"end":1931586},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1931586},"to":{"change":3,"start":1920994,"end":1920994},"introduced_by":3}],"inode":{"change":3,"pos":1920994}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1920994},"to":{"change":3,"start":1920995,"end":1931546},"introduced_by":3}],"inode":{"change":3,"pos":1920994}},"content":[{"Del":";;; ement-macros.el --- Ement macros -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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;;;; Requirements\n\n(require 'map)\n\n;;;; Debugging\n\n(require 'warnings)\n\n;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable\n;; `ement-debug' messages. This is commented out by default because, even though the\n;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if\n;; that is so at expansion time, the expanded macro calls format the message and check the\n;; log level at runtime, which is not zero-cost.\n\n;; (eval-and-compile\n;; (setq-local warning-minimum-log-level nil)\n;; (setq-local warning-minimum-log-level :debug))\n\n(cl-defmacro ement-debug (&rest args)\n \"Display a debug warning showing the runtime value of ARGS.\nThe warning automatically includes the name of the containing\nfunction, and it is only displayed if `warning-minimum-log-level'\nis `:debug' at expansion time (otherwise the macro expands to a\ncall to `ignore' with ARGS and is eliminated by the\nbyte-compiler). When debugging, the form also returns nil so,\ne.g. it may be used in a conditional in place of nil.\n\nEach of ARGS may be a string, which is displayed as-is, or a\nsymbol, the value of which is displayed prefixed by its name, or\na Lisp form, which is displayed prefixed by its first symbol.\n\nBefore the actual ARGS arguments, you can write keyword\narguments, i.e. alternating keywords and values. The following\nkeywords are supported:\n\n :buffer BUFFER Name of buffer to pass to `display-warning'.\n :level LEVEL Level passed to `display-warning', which see.\n Default is :debug.\"\n ;; TODO: Can we use a compiler macro to handle this more elegantly?\n (pcase-let* ((fn-name (when byte-compile-current-buffer\n (with-current-buffer byte-compile-current-buffer\n ;; This is a hack, but a nifty one.\n (save-excursion\n (beginning-of-defun)\n (cl-second (read (current-buffer)))))))\n (plist-args (cl-loop while (keywordp (car args))\n collect (pop args)\n collect (pop args)))\n ((map (:buffer buffer) (:level level)) plist-args)\n (level (or level :debug))\n (string (cl-loop for arg in args\n concat (pcase arg\n ((pred stringp) \"%S \")\n ((pred symbolp)\n (concat (upcase (symbol-name arg)) \":%S \"))\n ((pred listp)\n (concat \"(\" (upcase (symbol-name (car arg)))\n (pcase (length arg)\n (1 \")\")\n (_ \"...)\"))\n \":%S \"))))))\n (if (eq :debug warning-minimum-log-level)\n `(let ((fn-name ,(if fn-name\n `',fn-name\n ;; In an interpreted function: use `backtrace-frame' to get the\n ;; function name (we have to use a little hackery to figure out\n ;; how far up the frame to look, but this seems to work).\n `(cl-loop for frame in (backtrace-frames)\n for fn = (cl-second frame)\n when (not (or (subrp fn)\n (special-form-p fn)\n (eq 'backtrace-frames fn)))\n return (make-symbol (format \"%s [interpreted]\" fn))))))\n (display-warning fn-name (format ,string ,@args) ,level ,buffer)\n nil)\n `(ignore ,@args))))\n\n;;;; Macros\n\n(defmacro ement-alist (&rest pairs)\n \"Expand to an alist of the keys and values in PAIRS.\"\n `(list ,@(cl-loop for (key value) on pairs by #'cddr\n collect `(cons ,key ,value))))\n\n;;;;; Anaphoric\n\n;; We could just depend on dash.el and use --first, and anaphora.el (only\n;; on MELPA, not ELPA) has aprog1, but in order to reduce dependencies...\n\n(defmacro ement-afirst (form list)\n ;; Sometimes checkdoc is really annoying. If I use \"FORM returns\" or\n ;; \"FORM evaluates\", it complains, so I can't have a clean linting.\n \"Return the first element of LIST for which FORM is non-nil.\nIn FORM, `it' is bound to the element being tested.\"\n (declare (indent 1))\n `(cl-loop for it in ,list\n ;; Avoid the `when' clause's implicit binding of `it'.\n do (when ,form\n (cl-return it))))\n\n(defmacro ement-aprog1 (first &rest body)\n \"Like `prog1', but FIRST's value is bound to `it' around BODY.\"\n (declare (indent 1))\n `(let ((it ,first))\n ,@body\n it))\n\n(defmacro ement-singly (place-form &rest body)\n \"If PLACE-FORM is nil, set it non-nil and eval BODY.\nBODY should set PLACE-FORM to nil when BODY is eligible to run\nagain.\"\n (declare (indent defun))\n `(unless ,place-form\n (setf ,place-form t)\n ,@body))\n\n;;;;; Progress reporters\n\n;; MAYBE: Submit a `with-progress-reporter' macro to Emacs.\n\n(defalias 'ement-progress-update #'ignore\n \"By default, this function does nothing. But inside\n`ement-with-progress-reporter', it's bound to a function that\nupdates the current progress reporter.\")\n\n(defmacro ement-with-progress-reporter (args &rest body)\n \"Eval BODY with a progress reporter according to ARGS.\nARGS is a plist of these values:\n\n :when If specified, a form evaluated at runtime to determine\n whether to make and update a progress reporter. If not\n specified, the reporter is always made and updated.\n\n :reporter A list of arguments passed to\n `make-progress-reporter', which see.\n\nAround BODY, the function `ement-progress-update' is set to a\nfunction that calls `progress-reporter-update' on the progress\nreporter (or if the :when form evaluates to nil, the function is\nset to `ignore'). It optionally takes a VALUE argument, and\nwithout one, it automatically updates the value from the\nreporter's min-value to its max-value.\"\n (declare (indent defun))\n (pcase-let* ((progress-reporter-sym (gensym))\n (progress-value-sym (gensym))\n (start-time-sym (gensym))\n ((map (:when when-form) (:reporter reporter-args)) args)\n (`(,_message ,min-value ,_max-value) reporter-args)\n (update-fn `(cl-function\n (lambda (&optional (value (cl-incf ,progress-value-sym)))\n (ement-debug \"Updating progress reporter to\" value)\n (progress-reporter-update ,progress-reporter-sym value)))))\n `(let* ((,start-time-sym (current-time))\n (,progress-value-sym (or ,min-value 0))\n (,progress-reporter-sym ,(if when-form\n `(when ,when-form\n (make-progress-reporter ,@reporter-args))\n `(make-progress-reporter ,@reporter-args))))\n ;; We use `cl-letf' rather than `cl-labels', because labels expand to lambdas and funcalls,\n ;; so other functions that call `ement-progress-update' wouldn't call this definition.\n (cl-letf (((symbol-function 'ement-progress-update)\n ,(if when-form\n `(if ,when-form\n ,update-fn\n #'ignore)\n update-fn)))\n ,@body\n (ement-debug (format \"Ement: Progress reporter done (took %.2f seconds)\"\n (float-time (time-subtract (current-time) ,start-time-sym))))))))\n\n;;;;; Room-related macros\n\n;; Prevent compiler from complaining that `value' is an unknown slot.\n(require 'magit-section)\n\n(cl-defmacro ement-with-room-and-session (&rest body)\n \"Eval BODY with `ement-room' and `ement-session' bound.\nIf in an `ement-room-list-mode' buffer and `current-prefix-arg'\nis nil, use the room and session at point. If in an `ement-room'\nbuffer and `current-prefix-arg' is nil, use buffer-local value of\n`ement-room' and `ement-session'. Otherwise, prompt for them\nwith `ement-complete-room' or that given with :prompt-form.\n\nBODY may begin with property list arguments, including:\n\n :prompt-form A Lisp form evaluated for the binding of\n `ement-room'.\"\n (declare (indent defun))\n (pcase-let* ((plist (cl-loop while (keywordp (car body))\n append (list (car body) (cadr body))\n and do (setf body (cddr body))))\n (prompt-form (or (plist-get plist :prompt-form)\n '(ement-complete-room :suggest t))))\n `(pcase-let* ((`[,list-room ,list-session] (if (eq 'ement-room-list-mode major-mode)\n (oref (magit-current-section) value)\n [nil nil]))\n (ement-room (or list-room ement-room))\n (ement-session (or list-session ement-session)))\n (when (or current-prefix-arg (not ement-room))\n (pcase-let ((`(,room ,session) ,prompt-form))\n (setf ement-room room\n ement-session session)))\n ,@body)))\n\n;;;; Variables\n\n\n;;;; Customization\n\n\n;;;; Commands\n\n\n;;;; Functions\n\n\n;;;; Footer\n\n(provide 'ement-macros)\n\n;;; ement-macros.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-notify.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1920953,"end":1920992},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1920992},"to":{"change":3,"start":1903029,"end":1903029},"introduced_by":3}],"inode":{"change":3,"pos":1903029}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1903029},"to":{"change":3,"start":1903030,"end":1920952},"introduced_by":3}],"inode":{"change":3,"pos":1903029}},"content":[{"Del":";;; ement-notify.el --- Notifications for Ement events -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library implements notifications for Ement events.\n\n;;; Code:\n\n;;;; Requirements\n\n(require 'cl-lib)\n(require 'map)\n(require 'notifications)\n\n(require 'ement-lib)\n(require 'ement-room)\n\n(eval-when-compile\n (require 'ement-structs))\n\n;;;; Variables\n\n(declare-function ement-room-list \"ement-room-list\")\n(defvar ement-notify-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"S-\") #'ement-notify-reply)\n (define-key map (kbd \"M-g M-l\") #'ement-room-list)\n (define-key map (kbd \"M-g M-m\") #'ement-notify-switch-to-mentions-buffer)\n (define-key map (kbd \"M-g M-n\") #'ement-notify-switch-to-notifications-buffer)\n (make-composed-keymap (list map button-buffer-map) 'view-mode-map))\n \"Map for Ement notification buffers.\")\n\n(defvar ement-notify-dbus-p\n (and (featurep 'dbusbind)\n (require 'dbus nil :no-error)\n (dbus-ignore-errors (dbus-get-unique-name :session))\n ;; By default, emacs waits up to 25 seconds for a PONG. Realistically, if there's\n ;; no pong after 2000ms, there's pretty sure no notification service connected or\n ;; the system's setup has issues.\n (dbus-ping :session \"org.freedesktop.Notifications\" 2000))\n \"Whether D-Bus notifications are usable.\")\n\n;;;; Customization\n\n(defgroup ement-notify nil\n \"Notification options.\"\n :group 'ement)\n\n(defcustom ement-notify-ignore-predicates\n '(ement-notify--event-not-message-p ement-notify--event-from-session-user-p)\n \"Display notification if none of these return non-nil for an event.\nEach predicate is called with three arguments: the event, the\nroom, and the session (each the respective struct).\"\n :type '(repeat (choice (function-item ement-notify--event-not-message-p)\n (function-item ement-notify--event-from-session-user-p)\n (function :tag \"Custom predicate\"))))\n\n(defcustom ement-notify-log-predicates\n '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p\n ement-notify--room-buffer-live-p\n ement-notify--room-unread-p)\n \"Predicates to determine whether to log an event to the notifications buffer.\nIf one of these returns non-nil for an event, the event is logged.\"\n :type 'hook\n :options '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p\n ement-notify--room-buffer-live-p\n ement-notify--room-unread-p))\n\n(defcustom ement-notify-mark-frame-urgent-predicates\n '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p)\n \"Predicates to determine whether to mark a frame as urgent.\nIf one of these returns non-nil for an event, the frame that most\nrecently showed the event's room's buffer is marked\nurgent. (Only works on X, not other GUI platforms.)\"\n :type 'hook\n :options '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p))\n\n(defcustom ement-notify-mention-predicates\n '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p)\n \"Predicates to determine whether to log an event to the mentions buffer.\nIf one of these returns non-nil for an event, the event is logged.\"\n :type 'hook\n :options '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p))\n\n(defcustom ement-notify-notification-predicates\n '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p\n ement-notify--room-buffer-live-p\n ement-notify--room-unread-p)\n \"Predicates to determine whether to send a desktop notification.\nIf one of these returns non-nil for an event, the notification is sent.\"\n :type 'hook\n :options '(ement-notify--event-mentions-session-user-p\n ement-notify--event-mentions-room-p\n ement-notify--room-buffer-live-p\n ement-notify--room-unread-p))\n\n(defcustom ement-notify-sound nil\n \"Sound to play for notifications.\"\n :type '(choice (file :tag \"Sound file\")\n (string :tag \"XDG sound name\")\n (const :tag \"Default XDG message sound\" \"message-new-instant\")\n (const :tag \"Don't play a sound\" nil)))\n\n(defcustom ement-notify-limit-room-name-width nil\n \"Limit the width of room display names in mentions and notifications buffers.\nThis prevents the margin from being made excessively wide.\"\n :type '(choice (integer :tag \"Maximum width\")\n (const :tag \"Unlimited width\" nil)))\n\n(defcustom ement-notify-prism-background nil\n \"Add distinct background color by room to messages in notification buffers.\nThe color is specific to each room, generated automatically, and\ncan help distinguish messages by room.\"\n :type 'boolean)\n\n(defcustom ement-notify-room-avatars t\n \"Show room avatars in the notifications buffers.\nThis shows room avatars at the left of the window margin in\nnotification buffers. It's not customizeable beyond that due to\nlimitations and complexities of displaying strings and images in\nmargins in Emacs. But it's useful, anyway.\"\n :type 'boolean)\n\n;;;; Commands\n\n(declare-function ement-room-goto-event \"ement-room\")\n(defun ement-notify-button-action (button)\n \"Show BUTTON's event in its room buffer.\"\n ;; TODO: Is `interactive' necessary here?\n (interactive)\n (let* ((session (button-get button 'session))\n (room (button-get button 'room))\n (event (button-get button 'event)))\n (ement-view-room room session)\n (ement-room-goto-event event)))\n\n(defun ement-notify-reply ()\n \"Send a reply to event at point.\"\n (interactive)\n (save-window-excursion\n ;; Not sure why `call-interactively' doesn't work for `push-button' but oh well.\n (push-button)\n (call-interactively #'ement-room-write-reply)))\n\n(defun ement-notify-switch-to-notifications-buffer ()\n \"Switch to \\\"*Ement Notifications*\\\" buffer.\"\n (interactive)\n (switch-to-buffer (ement-notify--log-buffer \"*Ement Notifications*\")))\n\n(defun ement-notify-switch-to-mentions-buffer ()\n \"Switch to \\\"*Ement Mentions*\\\" buffer.\"\n (interactive)\n (switch-to-buffer (ement-notify--log-buffer \"*Ement Mentions*\")))\n\n;;;; Functions\n\n(defun ement-notify (event room session)\n \"Send notifications for EVENT in ROOM on SESSION.\nSends if all of `ement-notify-ignore-predicates' return nil.\nDoes not do anything if session hasn't finished initial sync.\"\n (when (and (ement-session-has-synced-p session)\n (cl-loop for pred in ement-notify-ignore-predicates\n never (funcall pred event room session)))\n (when (and ement-notify-dbus-p\n (run-hook-with-args-until-success 'ement-notify-notification-predicates event room session))\n (ement-notify--notifications-notify event room session))\n (when (run-hook-with-args-until-success 'ement-notify-log-predicates event room session)\n (ement-notify--log-to-buffer event room session))\n (when (run-hook-with-args-until-success 'ement-notify-mention-predicates event room session)\n (ement-notify--log-to-buffer event room session :buffer-name \"*Ement Mentions*\"))\n (when (run-hook-with-args-until-success 'ement-notify-mark-frame-urgent-predicates event room session)\n (ement-notify--mark-frame-urgent event room session))))\n\n(defun ement-notify--mark-frame-urgent (_event room _session)\n \"Mark frame showing ROOM's buffer as urgent.\nIf ROOM has no existing buffer, do nothing.\"\n (cl-labels ((mark-frame-urgent\n (frame) (let* ((prop \"WM_HINTS\")\n (hints (cl-coerce\n (x-window-property prop frame prop nil nil t)\n 'list)))\n (setf (car hints) (logior (car hints) 256))\n (x-change-window-property prop hints nil prop 32 t))))\n (when-let* ((buffer (alist-get 'buffer (ement-room-local room)))\n (frames (cl-loop for frame in (frame-list)\n when (eq 'x (framep frame))\n collect frame))\n (frame (pcase (length frames)\n (1 (car frames))\n (_\n ;; Use the frame that most recently showed ROOM's buffer.\n (car (sort frames\n (lambda (frame-a frame-b)\n (let ((a-pos (cl-position buffer (buffer-list frame-a)))\n (b-pos (cl-position buffer (buffer-list frame-b))))\n (cond ((and a-pos b-pos)\n (< a-pos b-pos))\n (a-pos)\n (b-pos))))))))))\n (mark-frame-urgent frame))))\n\n(defun ement-notify--notifications-notify (event room _session)\n \"Call `notifications-notify' for EVENT in ROOM on SESSION.\"\n (pcase-let* (((cl-struct ement-event sender content) event)\n ((cl-struct ement-room avatar (display-name room-displayname)) room)\n ((map body) content)\n (room-name (or room-displayname (ement--room-display-name room)))\n (sender-name (ement--user-displayname-in room sender))\n (title (format \"%s in %s\" sender-name room-name)))\n ;; TODO: Encode HTML entities.\n (when (stringp body)\n ;; If event has no body, it was probably redacted or something, so don't notify.\n (truncate-string-to-width body 60)\n (notifications-notify :title title :body body\n :app-name \"Ement.el\"\n :app-icon (when avatar\n (ement-notify--temp-file\n (plist-get (cdr (get-text-property 0 'display avatar)) :data)))\n :category \"im.received\"\n :timeout 5000\n ;; FIXME: Using :sound-file seems to do nothing, ever. Maybe a bug in notifications-notify?\n :sound-file (when (and ement-notify-sound\n (file-name-absolute-p ement-notify-sound))\n ement-notify-sound)\n :sound-name (when (and ement-notify-sound\n (not (file-name-absolute-p ement-notify-sound)))\n ement-notify-sound)\n ;; TODO: Show when action used.\n ;; :actions '(\"default\" \"Show\")\n ;; :on-action #'ement-notify-show\n ))))\n\n(cl-defun ement-notify--temp-file (content &key (timeout 5))\n \"Return a filename holding CONTENT, and delete it after TIMEOUT seconds.\"\n (let ((filename (make-temp-file \"ement-notify--temp-file-\"))\n (coding-system-for-write 'no-conversion))\n (with-temp-file filename\n (insert content))\n (run-at-time timeout nil (lambda ()\n (delete-file filename)))\n filename))\n\n(define-derived-mode ement-notify-mode ement-room-mode \"Ement Notify\"\n (setf ement-room-sender-in-left-margin nil\n left-margin-width 0\n right-margin-width 8)\n (setq-local ement-room-message-format-spec \"[%o%O] %S> %B%R%t\"\n bookmark-make-record-function #'ement-notify-bookmark-make-record))\n\n(cl-defun ement-notify--log-to-buffer (event room session &key (buffer-name \"*Ement Notifications*\"))\n \"Log EVENT in ROOM on SESSION to \\\"*Ement Notifications*\\\" buffer.\"\n (with-demoted-errors \"ement-notify--log-to-buffer: %S\"\n ;; HACK: We only log \"m.room.message\" events for now. This shouldn't be necessary\n ;; since we have `ement-notify--event-message-p' in `ement-notify-predicates', but\n ;; just to be safe...\n (when (equal \"m.room.message\" (ement-event-type event))\n (with-current-buffer (ement-notify--log-buffer buffer-name)\n (let* ((ement-session session)\n (ement-room room)\n (ement-room-sender-in-left-margin nil)\n (ement-room-message-format-spec \"%o%O »%W %S> %B%R%t\")\n (new-node (ement-room--insert-event event))\n (inhibit-read-only t)\n start end)\n (ewoc-goto-node ement-ewoc new-node)\n (setf start (point))\n (if-let (next-node (ewoc-next ement-ewoc new-node))\n (ewoc-goto-node ement-ewoc next-node)\n (goto-char (point-max)))\n (setf end (- (point) 2))\n (add-text-properties start end\n (list 'button '(t)\n 'category 'default-button\n 'action #'ement-notify-button-action\n 'session session\n 'room room\n 'event event))\n ;; Remove button face property.\n (alter-text-property start end 'face\n (lambda (face)\n (pcase face\n ('button nil)\n ((pred listp) (remq 'button face))\n (_ face))))\n (when ement-notify-prism-background\n (add-face-text-property start end (list :background (ement-notify--room-background-color room)\n :extend t))))))))\n\n(defun ement-notify--log-buffer (name)\n \"Return an Ement notifications buffer named NAME.\"\n (or (get-buffer name)\n (with-current-buffer (get-buffer-create name)\n (ement-notify-mode)\n (current-buffer))))\n\n(defun ement-notify--room-background-color (room)\n \"Return a background color on which to display ROOM's messages.\"\n (or (alist-get 'notify-background-color (ement-room-local room))\n (setf (alist-get 'notify-background-color (ement-room-local room))\n (let ((color (color-desaturate-name\n (ement--prism-color (ement-room-id room) :contrast-with (face-foreground 'default))\n 50)))\n (if (ement--color-dark-p (color-name-to-rgb (face-background 'default)))\n (color-darken-name color 25)\n (color-lighten-name color 25))))))\n\n;;;;; Predicates\n\n(defun ement-notify--event-mentions-session-user-p (event room session)\n \"Return non-nil if EVENT in ROOM mentions SESSION's user.\nIf EVENT's sender is SESSION's user, returns nil.\"\n (pcase-let* (((cl-struct ement-session user) session)\n ((cl-struct ement-event sender) event))\n (unless (equal (ement-user-id user) (ement-user-id sender))\n (ement-room--event-mentions-user-p event user room))))\n\n(defun ement-notify--room-buffer-live-p (_event room _session)\n \"Return non-nil if ROOM has a live buffer.\"\n (buffer-live-p (alist-get 'buffer (ement-room-local room))))\n\n(defun ement-notify--room-unread-p (_event room _session)\n \"Return non-nil if ROOM has unread notifications.\nAccording to the room's notification configuration on the server.\"\n (pcase-let* (((cl-struct ement-room unread-notifications) room)\n ((map notification_count highlight_count) unread-notifications))\n (not (and (equal 0 notification_count)\n (equal 0 highlight_count)))))\n\n(defun ement-notify--event-message-p (event _room _session)\n \"Return non-nil if EVENT is an \\\"m.room.message\\\" event.\"\n (equal \"m.room.message\" (ement-event-type event)))\n\n(defun ement-notify--event-not-message-p (event _room _session)\n \"Return non-nil if EVENT is not an \\\"m.room.message\\\" event.\"\n (not (equal \"m.room.message\" (ement-event-type event))))\n\n(defun ement-notify--event-from-session-user-p (event _room session)\n \"Return non-nil if EVENT is sent by SESSION's user.\"\n (equal (ement-user-id (ement-session-user session))\n (ement-user-id (ement-event-sender event))))\n\n(defalias 'ement-notify--event-mentions-room-p #'ement--event-mentions-room-p)\n\n;;;; Bookmark support\n\n;; Especially useful with Burly: \n\n(require 'bookmark)\n\n(defun ement-notify-bookmark-make-record ()\n \"Return a bookmark record for the current `ement-notify' buffer.\"\n (list (buffer-name)\n ;; It seems silly to have to record the buffer name twice, but the\n ;; `bookmark-make-record' function seems to override the bookmark name sometimes,\n ;; which makes the result useless unless we save the buffer name separately.\n (cons 'buffer-name (buffer-name))\n (cons 'handler #'ement-notify-bookmark-handler)))\n\n(defun ement-notify-bookmark-handler (bookmark)\n \"Show Ement notifications buffer for BOOKMARK.\"\n (pcase-let ((`(,_bookmark-name . ,(map buffer-name)) bookmark))\n (switch-to-buffer (ement-notify--log-buffer buffer-name))))\n\n;;;; Footer\n\n(provide 'ement-notify)\n\n;;; ement-notify.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-pkg.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1902991,"end":1903027},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1903027},"to":{"change":3,"start":1902506,"end":1902506},"introduced_by":3}],"inode":{"change":3,"pos":1902506}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1902506},"to":{"change":3,"start":1902507,"end":1902990},"introduced_by":3}],"inode":{"change":3,"pos":1902506}},"content":[{"Del":";; Generated package description from ement.el -*- no-byte-compile: t -*-\n(define-package \"ement\" \"0.9.2\" \"Matrix client\" '((emacs \"27.1\") (map \"2.1\") (persist \"0.5\") (plz \"0.2\") (taxy \"0.10\") (taxy-magit-section \"0.12.1\") (svg-lib \"0.2.5\") (transient \"0.3.7\")) :commit \"7f39fa5694232fa3f0a32b2104187fe1e886c202\" :authors '((\"Adam Porter\" . \"adam@alphapapa.net\")) :maintainer '(\"Adam Porter\" . \"adam@alphapapa.net\") :keywords '(\"comm\") :url \"https://github.com/alphapapa/ement.el\")\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-room-list.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1902462,"end":1902504},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1902504},"to":{"change":3,"start":1864406,"end":1864406},"introduced_by":3}],"inode":{"change":3,"pos":1864406}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1864406},"to":{"change":3,"start":1864407,"end":1902461},"introduced_by":3}],"inode":{"change":3,"pos":1864406}},"content":[{"Del":";;; ement-room-list.el --- List Ement rooms -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library implements a room list view using `taxy' and `taxy-magit-section' for\n;; dynamic, programmable grouping.\n\n;;; Code:\n\n(require 'button)\n(require 'rx)\n\n(require 'persist)\n(require 'svg-lib)\n(require 'taxy)\n(require 'taxy-magit-section)\n\n(require 'ement-lib)\n\n(defgroup ement-room-list nil\n \"Group Ement rooms with Taxy.\"\n :group 'ement)\n\n;;;; Mouse commands\n\n;; Since mouse-activated commands must handle mouse events, we define a simple macro to\n;; wrap a command into a mouse-event-accepting one.\n\n(defmacro ement-room-list-define-mouse-command (command)\n \"Define a command that calls COMMAND interactively with point at mouse event.\nCOMMAND should be a form that evaluates to a function symbol; if\na symbol, it should be unquoted..\"\n (let ((docstring (format \"Call command `%s' interactively with point at EVENT.\" command))\n (name (intern (format \"ement-room-list-mouse-%s\" command))))\n `(defun ,name (event)\n ,docstring\n (interactive \"e\")\n (mouse-set-point event)\n (call-interactively #',command))))\n\n;;;; Variables\n\n(declare-function ement-room-toggle-space \"ement-room\")\n\n(defvar ement-room-list-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"RET\") #'ement-room-list-RET)\n (define-key map (kbd \"SPC\") #'ement-room-list-next-unread)\n (define-key map [tab] #'ement-room-list-section-toggle)\n (define-key map [mouse-1] (ement-room-list-define-mouse-command ement-room-list-RET))\n (define-key map [mouse-2] (ement-room-list-define-mouse-command ement-room-list-kill-buffer))\n (define-key map (kbd \"k\") #'ement-room-list-kill-buffer)\n (define-key map (kbd \"s\") #'ement-room-toggle-space)\n map)\n \"Keymap for `ement-room-list' buffers.\nSee also `ement-room-list-button-map'.\")\n\n(defvar ement-room-list-button-map\n ;; This map is needed because some columns are propertized as buttons, which override\n ;; the main keymap.\n ;; TODO: Is it possible to adjust the button properties to obviate this map?\n (let ((map (make-sparse-keymap)))\n (define-key map [mouse-1] (ement-room-list-define-mouse-command ement-room-list-RET))\n (define-key map [mouse-2] (ement-room-list-define-mouse-command ement-room-list-kill-buffer))\n map)\n \"Keymap for buttonized text in `ement-room-list' buffers.\")\n\n(defvar ement-room-list-timestamp-colors nil\n \"List of colors used for timestamps.\nSet automatically when `ement-room-list-mode' is activated.\")\n\n(defvar ement-room)\n(defvar ement-session)\n(defvar ement-sessions)\n(defvar ement-room-prism-minimum-contrast)\n\n;;;;; Persistent variables\n\n(persist-defvar ement-room-list-visibility-cache nil\n \"Applied to `magit-section-visibility-cache', which see.\")\n\n;;;; Customization\n\n(defcustom ement-room-list-auto-update t\n \"Automatically update the taxy-based room list buffer.\"\n :type 'boolean)\n\n(defcustom ement-room-list-avatars (display-images-p)\n \"Show room avatars in the room list.\"\n :type 'boolean)\n\n;;;;; Faces\n\n(defface ement-room-list-direct\n ;; In case `font-lock-constant-face' is bold, we set the weight to normal, so it can be\n ;; made bold for unread rooms only.\n '((t (:weight normal :inherit (font-lock-constant-face ement-room-list-name))))\n \"Direct rooms.\")\n\n(defface ement-room-list-favourite '((t (:inherit (font-lock-doc-face ement-room-list-name))))\n \"Favourite rooms.\")\n\n(defface ement-room-list-invited\n '((t (:inherit italic ement-room-list-name)))\n \"Invited rooms.\")\n\n(defface ement-room-list-left\n '((t (:strike-through t :inherit ement-room-list-name)))\n \"Left rooms.\")\n\n(defface ement-room-list-low-priority '((t (:inherit (font-lock-comment-face ement-room-list-name))))\n \"Low-priority rooms.\")\n\n(defface ement-room-list-name\n '((t (:inherit font-lock-function-name-face button)))\n \"Non-direct rooms.\")\n\n(defface ement-room-list-space '((t (:inherit (font-lock-regexp-grouping-backslash ement-room-list-name))))\n \"Space rooms.\"\n :group 'ement-room-list)\n\n(defface ement-room-list-unread\n '((t (:inherit bold ement-room-list-name)))\n \"Unread rooms.\")\n\n(defface ement-room-list-recent '((t (:inherit font-lock-warning-face)))\n \"Latest timestamp of recently updated rooms.\nThe foreground color is used to generate a gradient of colors\nfrom recent to non-recent for rooms updated in the past 24\nhours but at least one hour ago.\")\n\n(defface ement-room-list-very-recent '((t (:inherit error)))\n \"Latest timestamp of very recently updated rooms.\nThe foreground color is used to generate a gradient of colors\nfrom recent to non-recent for rooms updated in the past hour.\")\n\n;;;; Keys\n\n;; Since some of these keys need access to the session, and room\n;; structs don't include the session, we use a two-element vector in\n;; which the session is the second element.\n\n(eval-and-compile\n (taxy-define-key-definer ement-room-list-define-key\n ement-room-list-keys \"ement-room-list-key\" \"FIXME: Docstring.\"))\n\n(ement-room-list-define-key membership (&key name status)\n ;; FIXME: Docstring: status should be a symbol of either `invite', `join', `leave'.\n (cl-labels ((format-membership (membership)\n (pcase membership\n ('join \"Joined\")\n ('invite \"Invited\")\n ('leave \"[Left]\"))))\n (pcase-let ((`[,(cl-struct ement-room (status membership)) ,_session] item))\n (if status\n (when (equal status membership)\n (or name (format-membership membership)))\n (format-membership membership)))))\n\n(ement-room-list-define-key alias (&key name regexp)\n (pcase-let ((`[,(cl-struct ement-room canonical-alias) ,_session] item))\n (when canonical-alias\n (when (string-match-p regexp canonical-alias)\n name))))\n\n(ement-room-list-define-key buffer ()\n (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))\n (when buffer\n #(\"Buffers\" 0 7 (help-echo \"Rooms with open buffers\")))))\n\n(ement-room-list-define-key direct ()\n (pcase-let ((`[,room ,session] item))\n (when (ement--room-direct-p room session)\n \"Direct\")))\n\n(ement-room-list-define-key people ()\n (pcase-let ((`[,room ,session] item))\n (when (ement--room-direct-p room session)\n (propertize \"People\" 'face 'ement-room-list-direct))))\n\n(ement-room-list-define-key space (&key name id)\n (pcase-let* ((`[,room ,session] item)\n ((cl-struct ement-session rooms) session)\n ((cl-struct ement-room type (local (map parents))) room))\n (cl-labels ((format-space\n (id) (let* ((parent-room (cl-find id rooms :key #'ement-room-id :test #'equal))\n (space-name (if parent-room\n (ement-room-display-name parent-room)\n id)))\n (concat \"Space: \" space-name))))\n (when-let ((key (if id\n ;; ID specified.\n (cond ((or (member id parents)\n (equal id (ement-room-id room)))\n ;; Room is in specified space.\n (or name (format-space id)))\n ((and (equal type \"m.space\")\n (equal id (ement-room-id room)))\n ;; Room is a specified space.\n (or name (concat \"Space: \" (ement-room-display-name room)))\n ))\n ;; ID not specified.\n (pcase (length parents)\n (0 nil)\n (1\n ;; TODO: Make the rooms list a hash table to avoid this lookup.\n (format-space (car parents)))\n (_\n ;; TODO: How to handle this better? (though it should be very rare)\n (string-join (mapcar #'format-space parents) \", \"))))))\n (propertize key 'face 'ement-room-list-space)))))\n\n(ement-room-list-define-key space-p ()\n \"Groups rooms that are themselves spaces.\"\n (pcase-let* ((`[,room ,_session] item)\n ((cl-struct ement-room type) room))\n (when (equal \"m.space\" type)\n \"Spaces\")))\n\n(ement-room-list-define-key name (&key name regexp)\n (pcase-let* ((`[,room ,_session] item)\n (display-name (ement--room-display-name room)))\n (when display-name\n (when (string-match-p regexp display-name)\n (or name regexp)))))\n\n(ement-room-list-define-key latest (&key name newer-than older-than)\n (pcase-let* ((`[,room ,_session] item)\n ((cl-struct ement-room latest-ts) room)\n (age))\n (when latest-ts\n (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))\n (cond (newer-than\n (when (<= age newer-than)\n (or name (format \"Newer than %s seconds\" newer-than))))\n (older-than\n (when (>= age older-than)\n (or name (format \"Older than %s seconds\" newer-than))))\n (t\n ;; Default to rooms with traffic in the last day.\n (if (<= age 86400)\n \"Last 24 hours\"\n \"Older than 24 hours\"))))))\n\n(ement-room-list-define-key freshness\n (&key (intervals '((86400 . \"Past 24h\")\n (604800 . \"Past week\")\n (2419200 . \"Past month\")\n (31536000 . \"Past year\"))))\n (pcase-let* ((`[,room ,_session] item)\n ((cl-struct ement-room latest-ts) room)\n (age))\n (when latest-ts\n (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))\n (or (alist-get age intervals nil nil #'>)\n \"Older than a year\"))))\n\n(ement-room-list-define-key session (&optional user-id)\n (pcase-let ((`[,_room ,(cl-struct ement-session\n (user (cl-struct ement-user id)))]\n item))\n (pcase user-id\n (`nil id)\n (_ (when (equal user-id id)\n user-id)))))\n\n(ement-room-list-define-key topic (&key name regexp)\n (pcase-let ((`[,(cl-struct ement-room topic) ,_session] item))\n (when (and topic (string-match-p regexp topic))\n name)))\n\n(ement-room-list-define-key unread ()\n (pcase-let ((`[,room ,session] item))\n (when (ement--room-unread-p room session)\n \"Unread\")))\n\n(ement-room-list-define-key favourite ()\n :then #'identity\n (pcase-let ((`[,room ,_session] item))\n (when (ement--room-favourite-p room)\n (propertize \"Favourite\" 'face 'ement-room-list-favourite))))\n\n(ement-room-list-define-key low-priority ()\n :then #'identity\n (pcase-let ((`[,room ,_session] item))\n (when (ement--room-low-priority-p room)\n \"Low-priority\")))\n\n(defcustom ement-room-list-default-keys\n '(;; First, group all invitations (this group will appear first since the rooms are\n ;; already sorted first).\n ((membership :status 'invite))\n ;; Group all left rooms (this group will appear last, because the rooms are already\n ;; sorted last).\n ((membership :status 'leave))\n ;; Group all favorite rooms, which are already sorted first.\n (favourite)\n ;; Group all low-priority rooms, which are already sorted last, and within that group,\n ;; group them by their space, if any.\n (low-priority space)\n ;; Group other rooms which are opened in a buffer.\n (buffer)\n ;; Group other rooms which are unread.\n (unread)\n ;; Group other rooms which are in a space by freshness, then by space.\n ((and :name \"Spaced\"\n :keys ((not space-p)\n space))\n freshness space)\n ;; Group spaces themselves by their parent space (since space headers can't also be\n ;; items, we have to handle them separately; a bit of a hack, but not too bad).\n ((and :name \"Spaces\" :keys (space-p))\n space)\n ;; Group rooms which aren't in spaces by their freshness.\n ((and :name \"Unspaced\"\n :keys ((not space)\n (not people)))\n freshness)\n ;; Group direct rooms by freshness.\n (people freshness))\n \"Default keys.\"\n :type 'sexp)\n\n;;;; Columns\n\n(eval-and-compile\n (taxy-magit-section-define-column-definer \"ement-room-list\"))\n\n(ement-room-list-define-column #(\"🐱\" 0 1 (help-echo \"Avatar\")) (:align 'right)\n (pcase-let* ((`[,room ,_session] item)\n ((cl-struct ement-room avatar display-name\n (local (map room-list-avatar)))\n room))\n (if ement-room-list-avatars\n (or room-list-avatar\n (let ((new-avatar\n (if avatar\n ;; NOTE: We resize every avatar to be suitable for this buffer, rather than using\n ;; the one cached in the room's struct. If the buffer's faces change height, this\n ;; will need refreshing, but it should be worth it to avoid resizing the images on\n ;; every update.\n (propertize \" \" 'display\n (ement--resize-image (get-text-property 0 'display avatar)\n nil (frame-char-height)))\n ;; Room has no avatar: make one.\n (let* ((string (or display-name (ement--room-display-name room)))\n (ement-room-prism-minimum-contrast 1)\n (color (ement--prism-color string :contrast-with \"white\")))\n (when (string-match (rx bos (or \"#\" \"!\" \"@\")) string)\n (setf string (substring string 1)))\n (propertize \" \" 'display (svg-lib-tag (substring string 0 1) nil\n :background color :foreground \"white\"\n :stroke 0))))))\n (setf (alist-get 'room-list-avatar (ement-room-local room)) new-avatar)))\n ;; Avatars disabled: use a two-space string.\n \" \")))\n\n(ement-room-list-define-column \"Name\" (:max-width 25)\n (pcase-let* ((`[,room ,session] item)\n ((cl-struct ement-room type) room)\n (display-name (ement--room-display-name room))\n (face))\n (or (when display-name\n ;; TODO: Use code from ement-room-list and put in a dedicated function.\n (setf face (cl-copy-list '(:inherit (ement-room-list-name))))\n ;; In concert with the \"Unread\" column, this is roughly equivalent to the\n ;; \"red/gray/bold/idle\" states listed in .\n (when (ement--room-unread-p room session)\n ;; For some reason, `push' doesn't work with `map-elt'...or does it?\n (push 'ement-room-list-unread (map-elt face :inherit)))\n (when (equal \"m.space\" type)\n (push 'ement-room-list-space (map-elt face :inherit)))\n (when (ement--room-direct-p room session)\n (push 'ement-room-list-direct (map-elt face :inherit)))\n (when (ement--room-favourite-p room)\n (push 'ement-room-list-favourite (map-elt face :inherit)))\n (when (ement--room-low-priority-p room)\n (push 'ement-room-list-low-priority (map-elt face :inherit)))\n (pcase (ement-room-status room)\n ('invite\n (push 'ement-room-list-invited (map-elt face :inherit)))\n ('leave\n (push 'ement-room-list-left (map-elt face :inherit))))\n (propertize display-name\n 'face face\n 'mouse-face 'highlight\n 'keymap ement-room-list-button-map))\n \"\")))\n\n(ement-room-list-define-column #(\"Unread\" 0 6 (help-echo \"Unread events (Notifications:Highlights)\")) (:align 'right)\n (pcase-let* ((`[,(cl-struct ement-room unread-notifications) ,_session] item)\n ((map notification_count highlight_count) unread-notifications))\n (if (or (not unread-notifications)\n (and (equal 0 notification_count)\n (equal 0 highlight_count)))\n \"\"\n (concat (propertize (number-to-string notification_count)\n 'face (if (zerop highlight_count)\n 'default\n 'ement-room-mention))\n \":\"\n (propertize (number-to-string highlight_count)\n 'face 'highlight)))))\n\n(ement-room-list-define-column \"Latest\" ()\n (pcase-let ((`[,(cl-struct ement-room latest-ts) ,_session] item))\n (if latest-ts\n (let* ((difference-seconds (- (float-time) (/ latest-ts 1000)))\n (n (cl-typecase difference-seconds\n ((number 0 3599) ;; <1 hour: 10-minute periods.\n (truncate (/ difference-seconds 600)))\n ((number 3600 86400) ;; 1 hour to 1 day: 24 1-hour periods.\n (+ 6 (truncate (/ difference-seconds 3600))))\n (otherwise ;; Difference in weeks.\n (min (/ (length ement-room-list-timestamp-colors) 2)\n (+ 24 (truncate (/ difference-seconds 86400 7)))))))\n (face (list :foreground (elt ement-room-list-timestamp-colors n)))\n (formatted-ts (ement--human-format-duration difference-seconds 'abbreviate)))\n (string-match (rx (1+ digit) (repeat 1 alpha)) formatted-ts)\n (propertize (match-string 0 formatted-ts) 'face face\n 'help-echo formatted-ts))\n \"\")))\n\n(ement-room-list-define-column \"Topic\" (:max-width 35)\n (pcase-let ((`[,(cl-struct ement-room topic status) ,_session] item))\n ;; FIXME: Can the status and type unified, or is this inherent to the spec?\n (when topic\n (setf topic (replace-regexp-in-string \"\\n\" \" \" topic 'fixedcase 'literal)))\n (pcase status\n ('invite (concat (propertize \"[invited]\"\n 'face 'ement-room-list-invited)\n \" \" topic))\n ('leave (concat (propertize \"[left]\"\n 'face 'ement-room-list-left)\n \" \" topic))\n (_ (or topic \"\")))))\n\n(ement-room-list-define-column \"Members\" (:align 'right)\n (pcase-let ((`[,(cl-struct ement-room\n (summary (map ('m.joined_member_count member-count))))\n ,_session]\n item))\n (if member-count\n (number-to-string member-count)\n \"\")))\n\n(ement-room-list-define-column #(\"Notifications\" 0 5 (help-echo \"Notification state\")) ()\n (pcase-let* ((`[,room ,session] item))\n (pcase (ement-room-notification-state room session)\n ('nil \"default\")\n ('all-loud \"all (loud)\")\n ('all \"all\")\n ('mentions-and-keywords \"mentions\")\n ('none \"none\"))))\n\n(ement-room-list-define-column #(\"B\" 0 1 (help-echo \"Buffer exists for room\")) ()\n (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))\n (if buffer\n #(\"B\" 0 1 (help-echo \"Buffer exists for room\"))\n \" \")))\n\n(ement-room-list-define-column \"Session\" ()\n (pcase-let ((`[,_room ,(cl-struct ement-session (user (cl-struct ement-user id)))] item))\n id))\n\n(unless ement-room-list-columns\n ;; TODO: Automate this or document it\n (setq-default ement-room-list-columns\n (get 'ement-room-list-columns 'standard-value)))\n\n;;;; Bookmark support\n\n;; Especially useful with Burly: \n\n(require 'bookmark)\n\n(defun ement-room-list-bookmark-make-record ()\n \"Return a bookmark record for the `ement-room-list' buffer.\"\n (list \"*Ement Room List*\"\n (cons 'handler #'ement-room-list-bookmark-handler)))\n\n(defun ement-room-list-bookmark-handler (bookmark)\n \"Show `ement-room-list' room list buffer for BOOKMARK.\"\n (pcase-let* ((`(,_bookmark-name . ,_) bookmark))\n (unless ement-sessions\n ;; MAYBE: Automatically connect.\n (user-error \"No sessions connected: call `ement-connect' first\"))\n (ement-room-list)))\n\n;;;; Commands\n\n(defun ement-room-list-section-toggle ()\n \"Toggle the section at point.\"\n ;; HACK: For some reason, when a section's body is hidden, then the buffer is refreshed,\n ;; and then the section's body is shown again, the body is empty--but then, refreshing\n ;; the buffer shows its body. So we work around that by refreshing the buffer when a\n ;; section is toggled. In a way, it makes sense to do this anyway, so the user has the\n ;; most up-to-date information in the buffer. This hack also works around a minor\n ;; visual bug that sometimes causes room avatars to be displayed in a section heading\n ;; when a section is hidden.\n (interactive)\n (ignore-errors\n ;; Ignore an error in case point is past the top-level section.\n (cl-typecase (aref (oref (magit-current-section) value) 0)\n (ement-room\n ;; HACK: Don't hide rooms themselves (they end up permanently hidden).\n nil)\n (otherwise\n (call-interactively #'magit-section-toggle)\n (revert-buffer)))))\n\n;;;###autoload\n(defun ement-room-list--after-initial-sync (&rest _ignore)\n \"Call `ement-room-list', ignoring arguments.\nTo be called from `ement-after-initial-sync-hook'.\"\n (ement-room-list))\n\n;;;###autoload\n(defalias 'ement-list-rooms 'ement-room-list)\n\n;;;###autoload\n(cl-defun ement-room-list (&key (buffer-name \"*Ement Room List*\")\n (keys ement-room-list-default-keys)\n (display-buffer-action '((display-buffer-reuse-window display-buffer-same-window)))\n ;; visibility-fn\n )\n \"Show a buffer listing Ement rooms, grouped with Taxy KEYS.\nAfter showing it, its window is selected. The buffer is named\nBUFFER-NAME and is shown with DISPLAY-BUFFER-ACTION; or if\nDISPLAY-BUFFER-ACTION is nil, the buffer is not displayed.\"\n (interactive)\n (let ((inhibit-read-only t)\n pos format-table column-sizes window-start room-session-vectors)\n (cl-labels (;; (heading-face\n ;; (depth) (list :inherit (list 'bufler-group (bufler-level-face depth))))\n (format-item (item) (gethash item format-table))\n ;; NOTE: Since these functions take an \"item\" (which is a [room session]\n ;; vector), they're prefixed \"item-\" rather than \"room-\".\n (item-latest-ts\n (item) (or (ement-room-latest-ts (elt item 0))\n ;; Room has no latest timestamp. FIXME: This shouldn't\n ;; happen, but it can, maybe due to oversights elsewhere.\n 0))\n (item-unread-p\n (item) (pcase-let ((`[,room ,session] item))\n (ement--room-unread-p room session)))\n (item-left-p\n (item) (pcase-let ((`[,(cl-struct ement-room status) ,_session] item))\n (equal 'leave status)))\n (item-buffer-p\n (item) (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))\n (buffer-live-p buffer)))\n (taxy-unread-p\n (taxy) (or (cl-some #'item-unread-p (taxy-items taxy))\n (cl-some #'taxy-unread-p (taxy-taxys taxy))))\n (item-space-p\n (item) (pcase-let ((`[,(cl-struct ement-room type) ,_session] item))\n (equal \"m.space\" type)))\n (item-favourite-p\n (item) (pcase-let ((`[,room ,_session] item))\n (ement--room-favourite-p room)))\n (item-low-priority-p\n (item) (pcase-let ((`[,room ,_session] item))\n (ement--room-low-priority-p room)))\n (visible-p\n ;; This is very confusing and doesn't currently work.\n (section) (let ((value (oref section value)))\n (if (cl-typecase value\n (taxy-magit-section (item-unread-p value))\n (ement-room nil))\n 'show\n 'hide)))\n (item-invited-p\n (item) (pcase-let ((`[,(cl-struct ement-room status) ,_session] item))\n (equal 'invite status)))\n (taxy-latest-ts\n (taxy) (apply #'max most-negative-fixnum\n (delq nil\n (list\n (when (taxy-items taxy)\n (item-latest-ts (car (taxy-items taxy))))\n (when (taxy-taxys taxy)\n (cl-loop for sub-taxy in (taxy-taxys taxy)\n maximizing (taxy-latest-ts sub-taxy)))))))\n (tnil (a b) (and (not a) b))\n (make-fn (&rest args)\n (apply #'make-taxy-magit-section\n :make #'make-fn\n :format-fn #'format-item\n :level-indent ement-room-list-level-indent\n ;; :visibility-fn #'visible-p\n ;; :heading-indent 2\n :item-indent 2\n ;; :heading-face-fn #'heading-face\n args)))\n ;; (when (get-buffer buffer-name)\n ;; (kill-buffer buffer-name))\n (unless ement-sessions\n (error \"Ement: Not connected. Use `ement-connect' to connect\"))\n (setf room-session-vectors\n (cl-loop for (_id . session) in ement-sessions\n append (cl-loop for room in (ement-session-rooms session)\n collect (vector room session))))\n (with-current-buffer (get-buffer-create buffer-name)\n (setf pos (point))\n (ement-room-list-mode)\n (delete-all-overlays)\n (erase-buffer)\n (if (not room-session-vectors)\n (insert \"No joined rooms. Use command `ement-join-room' to join a room, or `ement-directory' or `ement-directory-search' to find rooms.\")\n (let* ((taxy (cl-macrolet ((first-item\n (pred) `(lambda (taxy)\n (when (taxy-items taxy)\n (,pred (car (taxy-items taxy))))))\n (name= (name) `(lambda (taxy)\n (equal ,name (taxy-name taxy)))))\n (thread-last\n (make-fn\n :name \"Ement Rooms\"\n :take (taxy-make-take-function keys ement-room-list-keys))\n (taxy-fill room-session-vectors)\n (taxy-sort #'> #'item-latest-ts)\n (taxy-sort #'tnil #'item-low-priority-p)\n (taxy-sort #'tnil #'item-left-p)\n (taxy-sort* #'string< #'taxy-name)\n (taxy-sort* #'> #'taxy-latest-ts)\n (taxy-sort* #'tnil (first-item item-space-p))\n (taxy-sort* #'t>nil (name= \"Low-priority\"))\n (taxy-sort* #'t>nil (first-item item-left-p)))))\n (taxy-magit-section-insert-indent-items nil)\n (format-cons (taxy-magit-section-format-items\n ement-room-list-columns ement-room-list-column-formatters taxy))\n (section-ident (when (magit-current-section)\n (magit-section-ident (magit-current-section)))))\n (setf format-table (car format-cons)\n column-sizes (cdr format-cons)\n header-line-format (taxy-magit-section-format-header\n column-sizes ement-room-list-column-formatters)\n window-start (if (get-buffer-window buffer-name)\n (window-start (get-buffer-window buffer-name))\n 0))\n (when ement-room-list-visibility-cache\n (setf magit-section-visibility-cache ement-room-list-visibility-cache))\n (add-hook 'kill-buffer-hook #'ement-room-list--cache-visibility nil 'local)\n (save-excursion\n (taxy-magit-section-insert taxy :items 'first\n ;; :blank-between-depth bufler-taxy-blank-between-depth\n :initial-depth 0))\n (goto-char pos)\n (when (and section-ident (magit-get-section section-ident))\n (goto-char (oref (magit-get-section section-ident) start))))))\n (when display-buffer-action\n (when-let ((window (display-buffer buffer-name display-buffer-action)))\n (select-window window)))\n (when (get-buffer-window buffer-name)\n (set-window-start (get-buffer-window buffer-name) window-start))\n ;; NOTE: In order for `bookmark--jump-via' to work properly, the restored buffer\n ;; must be set as the current buffer, so we have to do this explicitly here.\n (set-buffer buffer-name))))\n\n(cl-defun ement-room-list-side-window (&key (side 'left))\n \"Show room list in side window on SIDE.\nInteractively, with prefix, show on right side; otherwise, on\nleft.\"\n (interactive (when current-prefix-arg\n (list :side 'right)))\n (let ((display-buffer-mark-dedicated t))\n ;; Not sure if binding `display-buffer-mark-dedicated' is still necessary.\n (ement-room-list\n :display-buffer-action `(display-buffer-in-side-window\n (dedicated . t)\n (side . ,side)\n (window-parameters\n\t\t\t (no-delete-other-windows . t))))))\n\n(defun ement-room-list-revert (&optional _ignore-auto _noconfirm)\n \"Revert current Ement-Room-List buffer.\"\n (interactive)\n (with-current-buffer \"*Ement Room List*\"\n ;; FIXME: This caching of the visibility only supports the main buffer with the\n ;; default name, not any special ones with different names.\n (setf ement-room-list-visibility-cache magit-section-visibility-cache))\n (ement-room-list :display-buffer-action nil))\n\n(defun ement-room-list-kill-buffer (room)\n \"Kill ROOM's buffer.\"\n (interactive\n (ement-with-room-and-session\n (ignore ement-session)\n (list ement-room)))\n (pcase-let (((cl-struct ement-room (local (map buffer))) room)\n (kill-buffer-query-functions))\n (when (buffer-live-p buffer)\n (kill-buffer buffer)\n (ement-room-list-revert))))\n\n(declare-function ement-view-room \"ement-room\")\n(defun ement-room-list-RET ()\n \"View room at point, or cycle section at point.\"\n (interactive)\n (cl-etypecase (oref (magit-current-section) value)\n (vector (pcase-let ((`[,room ,session] (oref (magit-current-section) value)))\n (ement-view-room room session)))\n (taxy-magit-section (call-interactively #'ement-room-list-section-toggle))\n (null nil)))\n\n(declare-function ement-room-goto-fully-read-marker \"ement-room\")\n(defun ement-room-list-next-unread ()\n \"Show next unread room.\"\n (interactive)\n (unless (button-at (point))\n (call-interactively #'forward-button))\n (unless (cl-loop with starting-line = (line-number-at-pos)\n for value = (oref (magit-current-section) value)\n for room = (elt value 0)\n for session = (elt value 1)\n if (ement--room-unread-p room session)\n do (progn\n (goto-char (button-end (button-at (point))))\n (push-button (1- (point)))\n (ement-room-goto-fully-read-marker)\n (cl-return t))\n else do (call-interactively #'forward-button)\n while (> (line-number-at-pos) starting-line))\n ;; No more unread rooms.\n (message \"No more unread rooms\")))\n\n(define-derived-mode ement-room-list-mode magit-section-mode \"Ement-Room-List\"\n :global nil\n (setq-local bookmark-make-record-function #'ement-room-list-bookmark-make-record\n revert-buffer-function #'ement-room-list-revert\n ement-room-list-timestamp-colors (ement-room-list--timestamp-colors)))\n\n;;;; Functions\n\n(defun ement-room-list--cache-visibility ()\n \"Save visibility cache.\nSets `ement-room-list-visibility-cache' to the value of\n`magit-section-visibility-cache'. To be called in\n`kill-buffer-hook'.\"\n (ignore-errors\n (when magit-section-visibility-cache\n (setf ement-room-list-visibility-cache magit-section-visibility-cache))))\n\n;;;###autoload\n(defun ement-room-list-auto-update (_session)\n \"Automatically update the Taxy room list buffer.\n+Does so when variable `ement-room-list-auto-update' is non-nil.\n+To be called in `ement-sync-callback-hook'.\"\n (when (and ement-room-list-auto-update\n (buffer-live-p (get-buffer \"*Ement Room List*\")))\n (with-current-buffer (get-buffer \"*Ement Room List*\")\n (unless (region-active-p)\n ;; Don't refresh the list if the region is active (e.g. if the user is trying to\n ;; operate on multiple rooms).\n (revert-buffer)))))\n\n(defun ement-room-list--timestamp-colors ()\n \"Return a vector of generated latest-timestamp colors for rooms.\nUsed in `ement-tabulated-room-list' and `ement-room-list'.\"\n (if (or (equal \"unspecified-fg\" (face-foreground 'default nil 'default))\n (equal \"unspecified-bg\" (face-background 'default nil 'default)))\n ;; NOTE: On a TTY, the default face's foreground and background colors may be the\n ;; special values \"unspecified-fg\"/\"unspecified-bg\", in which case we can't generate\n ;; gradients, so we just return a vector of \"unspecified-fg\". See\n ;; .\n (make-vector 134 \"unspecified-fg\")\n (cl-coerce\n (append (mapcar\n ;; One face per 10-minute period, from \"recent\" to 1-hour.\n (lambda (rgb)\n (pcase-let ((`(,r ,g ,b) rgb))\n (color-rgb-to-hex r g b 2)))\n (color-gradient (color-name-to-rgb (face-foreground 'ement-room-list-very-recent\n nil 'default))\n (color-name-to-rgb (face-foreground 'ement-room-list-recent\n nil 'default))\n 6))\n (mapcar\n ;; One face per hour, from \"recent\" to default.\n (lambda (rgb)\n (pcase-let ((`(,r ,g ,b) rgb))\n (color-rgb-to-hex r g b 2)))\n (color-gradient (color-name-to-rgb (face-foreground 'ement-room-list-recent\n nil 'default))\n (color-name-to-rgb (face-foreground 'default nil 'default))\n 24))\n (mapcar\n ;; One face per week for the last year (actually we\n ;; generate colors for the past two years' worth so\n ;; that the face for one-year-ago is halfway to\n ;; invisible, and we don't use colors past that point).\n (lambda (rgb)\n (pcase-let ((`(,r ,g ,b) rgb))\n (color-rgb-to-hex r g b 2)))\n (color-gradient (color-name-to-rgb (face-foreground 'default nil 'default))\n (color-name-to-rgb (face-background 'default nil 'default))\n 104)))\n 'vector)))\n\n;;;; Footer\n\n(provide 'ement-room-list)\n\n;;; ement-room-list.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-room.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1864367,"end":1864404},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1864404},"to":{"change":3,"start":1623515,"end":1623515},"introduced_by":3}],"inode":{"change":3,"pos":1623515}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1623515},"to":{"change":3,"start":1623516,"end":1864366},"introduced_by":3}],"inode":{"change":3,"pos":1623515}},"content":[{"Del":";;; ement-room.el --- Ement room buffers -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022 Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library implements buffers displaying events in a room.\n\n;; EWOC is a great library. If I had known about it and learned it\n;; sooner, it would have saved me a lot of time in other projects.\n;; I'm glad I decided to try it for this one.\n\n;;; Code:\n\n;;;; Debugging\n\n;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable\n;; `ement-debug' messages. This is commented out by default because, even though the\n;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if\n;; that is so at expansion time, the expanded macro calls format the message and check the\n;; log level at runtime, which is not zero-cost.\n\n;; (eval-and-compile\n;; (setq-local warning-minimum-log-level nil)\n;; (setq-local warning-minimum-log-level :debug))\n\n;;;; Requirements\n\n(require 'color)\n(require 'ewoc)\n(require 'mailcap)\n(require 'shr)\n(require 'subr-x)\n(require 'mwheel)\n(require 'dnd)\n\n(require 'ement-api)\n(require 'ement-lib)\n(require 'ement-macros)\n(require 'ement-structs)\n\n;;;; Structs\n\n(cl-defstruct ement-room-membership-events\n \"Struct grouping membership events.\nAfter adding events, use `ement-room-membership-events--update'\nto sort events and update other slots.\"\n (events nil :documentation \"Membership events, latest first.\")\n (earliest-ts nil :documentation \"Timestamp of earliest event.\")\n (latest-ts nil :documentation \"Timestamp of latest event.\"))\n\n(defun ement-room-membership-events--update (struct)\n \"Return STRUCT having sorted its events and updated its slots.\"\n ;; Like the room timeline slot, events are sorted latest-first. We also deduplicate\n ;; them , because it seems that we can end up with multiple copies of a membership event\n ;; (e.g. when loading old messages).\n (setf (ement-room-membership-events-events struct) (cl-delete-duplicates (ement-room-membership-events-events struct)\n :key #'ement-event-id :test #'equal)\n (ement-room-membership-events-events struct) (cl-sort (ement-room-membership-events-events struct) #'>\n :key #'ement-event-origin-server-ts)\n (ement-room-membership-events-earliest-ts struct) (ement-event-origin-server-ts\n (car (last (ement-room-membership-events-events struct))))\n (ement-room-membership-events-latest-ts struct) (ement-event-origin-server-ts\n (car (ement-room-membership-events-events struct))))\n struct)\n\n;;;; Variables\n\n(defvar-local ement-ewoc nil\n \"EWOC for Ement room buffers.\")\n\n(defvar-local ement-room nil\n \"Ement room for current buffer.\")\n\n(defvar-local ement-session nil\n \"Ement session for current buffer.\")\n\n(defvar-local ement-room-retro-loading nil\n \"Non-nil when earlier messages are being loaded.\nUsed to avoid overlapping requests.\")\n\n(defvar-local ement-room-replying-to-event nil\n \"When non-nil, the user is replying to this event.\nUsed by `ement-room-send-message'.\")\n\n(defvar-local ement-room-replying-to-overlay nil\n \"Used by `ement-room-write-reply'.\")\n\n(defvar-local ement-room-read-receipt-request nil\n \"Maps event ID to request updating read receipt to that event.\nAn alist of one entry.\")\n\n(defvar ement-room-read-string-setup-hook nil\n \"Normal hook run by `ement-room-read-string' after switching to minibuffer.\nShould be used to, e.g. propagate variables to the minibuffer.\")\n\n(defvar ement-room-compose-hook nil\n \"Hook run in compose buffers when created.\nUsed to, e.g. call `ement-room-compose-org'.\")\n\n(declare-function ement-room-list \"ement-room-list.el\")\n(declare-function ement-notify-switch-to-mentions-buffer \"ement-notify\")\n(declare-function ement-notify-switch-to-notifications-buffer \"ement-notify\")\n(defvar ement-room-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"?\") #'ement-room-transient)\n\n ;; Movement\n (define-key map (kbd \"TAB\") #'ement-room-goto-next)\n (define-key map (kbd \"\") #'ement-room-goto-prev)\n (define-key map (kbd \"SPC\") #'ement-room-scroll-up-mark-read)\n (define-key map (kbd \"S-SPC\") #'ement-room-scroll-down-command)\n (define-key map (kbd \"M-SPC\") #'ement-room-goto-fully-read-marker)\n (define-key map [remap scroll-down-command] #'ement-room-scroll-down-command)\n (define-key map [remap mwheel-scroll] #'ement-room-mwheel-scroll)\n\n ;; Switching\n (define-key map (kbd \"M-g M-l\") #'ement-room-list)\n (define-key map (kbd \"M-g M-r\") #'ement-view-room)\n (define-key map (kbd \"M-g M-m\") #'ement-notify-switch-to-mentions-buffer)\n (define-key map (kbd \"M-g M-n\") #'ement-notify-switch-to-notifications-buffer)\n (define-key map (kbd \"q\") #'quit-window)\n\n ;; Messages\n (define-key map (kbd \"RET\") #'ement-room-send-message)\n (define-key map (kbd \"S-\") #'ement-room-write-reply)\n (define-key map (kbd \"M-RET\") #'ement-room-compose-message)\n (define-key map (kbd \"\") #'ement-room-edit-message)\n (define-key map (kbd \"C-k\") #'ement-room-delete-message)\n (define-key map (kbd \"s r\") #'ement-room-send-reaction)\n (define-key map (kbd \"s e\") #'ement-room-send-emote)\n (define-key map (kbd \"s f\") #'ement-room-send-file)\n (define-key map (kbd \"s i\") #'ement-room-send-image)\n (define-key map (kbd \"v\") #'ement-room-view-event)\n\n ;; Users\n (define-key map (kbd \"u RET\") #'ement-send-direct-message)\n (define-key map (kbd \"u i\") #'ement-invite-user)\n (define-key map (kbd \"u I\") #'ement-ignore-user)\n\n ;; Room\n (define-key map (kbd \"M-s o\") #'ement-room-occur)\n (define-key map (kbd \"r d\") #'ement-describe-room)\n (define-key map (kbd \"r m\") #'ement-list-members)\n (define-key map (kbd \"r t\") #'ement-room-set-topic)\n (define-key map (kbd \"r f\") #'ement-room-set-message-format)\n (define-key map (kbd \"r n\") #'ement-room-set-notification-state)\n (define-key map (kbd \"r N\") #'ement-room-override-name)\n (define-key map (kbd \"r T\") #'ement-tag-room)\n\n ;; Room membership\n (define-key map (kbd \"R c\") #'ement-create-room)\n (define-key map (kbd \"R j\") #'ement-join-room)\n (define-key map (kbd \"R l\") #'ement-leave-room)\n (define-key map (kbd \"R F\") #'ement-forget-room)\n (define-key map (kbd \"R n\") #'ement-room-set-display-name)\n (define-key map (kbd \"R s\") #'ement-room-toggle-space)\n\n ;; Other\n (define-key map (kbd \"g\") #'ement-room-sync)\n map)\n \"Keymap for Ement room buffers.\")\n\n(defvar ement-room-minibuffer-map\n (let ((map (make-sparse-keymap)))\n (set-keymap-parent map minibuffer-local-map)\n (define-key map (kbd \"C-c '\") #'ement-room-compose-from-minibuffer)\n map)\n \"Keymap used in `ement-room-read-string'.\")\n\n(defvar ement-room-sender-in-headers nil\n \"Non-nil when sender is displayed in headers.\nIn that case, sender names are aligned to the margin edge.\")\n\n(defvar ement-room-messages-filter\n '((lazy_load_members . t))\n ;; NOTE: The confusing differences between what /sync and /messages\n ;; expect. See .\n \"Default RoomEventFilter for /messages requests.\")\n\n(defvar ement-room-typing-timer nil\n \"Timer used to send notifications while typing.\")\n\n(defvar ement-room-matrix.to-url-regexp\n (rx \"http\" (optional \"s\") \"://\"\n \"matrix.to\" \"/#/\"\n (group (or \"!\" \"#\") (1+ (not (any \"/\"))))\n (optional \"/\" (group \"$\" (1+ (not (any \"?\" \"/\")))))\n (optional \"?\" (group (1+ anything))))\n \"Regexp matching \\\"matrix.to\\\" URLs.\")\n\n;; Variables from other files.\n(defvar ement-sessions)\n(defvar ement-syncs)\n(defvar ement-auto-sync)\n(defvar ement-users)\n(defvar ement-images-queue)\n(defvar ement-notify-limit-room-name-width)\n(defvar ement-view-room-display-buffer-action)\n\n;; Defined in Emacs 28.1: silence byte-compilation warning in earlier versions.\n(defvar browse-url-handlers)\n\n;;;; Customization\n\n(defgroup ement-room nil\n \"Options for room buffers.\"\n :group 'ement)\n\n(defcustom ement-room-timestamp-header-align 'right\n \"Where to align timestamp headers.\"\n :type '(choice (const :tag \"Left\" left)\n (const :tag \"Center\" center)\n (const :tag \"Right\" right)))\n\n(defcustom ement-room-view-hook\n '(ement-room-view-hook-room-list-auto-update)\n \"Functions called when `ement-room-view' is called.\nCalled with two arguments, the room and the session.\"\n :type 'hook)\n\n;;;;; Faces\n\n(defface ement-room-name\n '((t (:inherit font-lock-function-name-face)))\n \"Room name shown in header line.\")\n\n(defface ement-room-membership\n '((t (:height 0.8 :inherit font-lock-comment-face)))\n \"Membership events (join/part).\")\n\n(defface ement-room-reactions\n '((t (:inherit font-lock-comment-face :height 0.9)))\n \"Reactions to messages (including the user count).\")\n\n(defface ement-room-reactions-key\n '((t (:inherit ement-room-reactions :height 1.5)))\n \"Reactions to messages (the key, i.e. the emoji part).\nUses a separate face to allow the key to be shown at a different\nsize, because in some fonts, emojis are too small relative to\nnormal text.\")\n\n(defface ement-room-timestamp\n '((t (:inherit font-lock-comment-face)))\n \"Event timestamps.\")\n\n(defface ement-room-user\n '((t (:inherit font-lock-function-name-face :weight bold :overline t)))\n \"Usernames.\")\n\n(defface ement-room-self\n '((t (:inherit (font-lock-variable-name-face ement-room-user) :weight bold)))\n \"Own username.\")\n\n(defface ement-room-message-text\n '((t (:inherit default)))\n \"Text message bodies.\")\n\n(defface ement-room-message-emote\n '((t (:inherit italic)))\n \"Emote message bodies.\")\n\n(defface ement-room-redacted\n '((t (:strike-through t)))\n \"Redacted messages.\")\n\n(defface ement-room-self-message\n '((t (:inherit (font-lock-variable-name-face))))\n \"Oneself's message bodies.\nNote that this does not need to inherit\n`ement-room-message-text', because that face is combined with\nthis one automatically.\")\n\n(defface ement-room-timestamp-header\n '((t (:inherit header-line :weight bold :height 1.1)))\n \"Timestamp headers.\")\n\n(defface ement-room-mention\n (if (version< emacs-version \"27.1\")\n '((t (:inherit hl-line)))\n '((t (:inherit hl-line :extend t))))\n \"Messages that mention the local user.\")\n\n(defface ement-room-wrap-prefix\n `((t :inherit highlight))\n \"Face applied to `ement-room-wrap-prefix', which see.\")\n\n;;;;; Options\n\n(defcustom ement-room-ellipsis \"⋮\"\n \"String used when abbreviating certain strings.\"\n :type 'string)\n\n(defcustom ement-room-avatars (display-images-p)\n \"Show room avatars.\"\n :type 'boolean)\n\n(defcustom ement-room-avatar-max-width 32\n \"Maximum width in pixels of room avatars shown in header lines.\"\n :type 'integer)\n\n(defcustom ement-room-avatar-max-height 32\n \"Maximum height in pixels of room avatars shown in header lines.\"\n :type 'integer)\n\n(defcustom ement-room-coalesce-events t\n \"Coalesce certain events in room buffers.\nFor example, membership events can be overwhelming in large\nrooms, especially ones bridged to IRC. This option groups them\ntogether so they take less space.\"\n :type 'boolean)\n\n(defcustom ement-room-header-line-format\n ;; TODO: Show in new screenshots.\n '(:eval (concat (if ement-room-avatars\n (or (ement-room-avatar ement-room)\n \"\")\n \"\")\n \" \" (propertize (ement-room--escape-%\n (or (ement-room-display-name ement-room)\n \"[no room name]\"))\n 'face 'ement-room-name)\n \": \" (propertize (ement-room--escape-%\n (or (ement-room-topic ement-room)\n \"[no topic]\"))\n ;; Also set help-echo in case the topic is too wide to fit.\n 'help-echo (ement-room-topic ement-room))))\n \"Header line format for room buffers.\nSee Info node `(elisp)Header lines'.\"\n :type 'sexp)\n(put 'ement-room-header-line-format 'risky-local-variable t)\n\n(defcustom ement-room-buffer-name-prefix \"*Ement Room: \"\n \"Prefix for Ement room buffer names.\"\n :type 'string)\n\n(defcustom ement-room-buffer-name-suffix \"*\"\n \"Suffix for Ement room buffer names.\"\n :type 'string)\n\n(defcustom ement-room-timestamp-format \"%H:%M:%S\"\n \"Format string for event timestamps.\nSee function `format-time-string'.\"\n :type '(choice (const \"%H:%M:%S\")\n (const \"%Y-%m-%d %H:%M:%S\")\n string))\n\n(defcustom ement-room-left-margin-width 0\n \"Width of left margin in room buffers.\nWhen using a non-graphical display, this should be set slightly\nwider than when using a graphical display, to prevent sender\ndisplay names from colliding with event text.\"\n :type 'integer)\n\n(defcustom ement-room-right-margin-width (length ement-room-timestamp-format)\n \"Width of right margin in room buffers.\"\n :type 'integer)\n\n(defcustom ement-room-sender-headers t\n \"Show sender headers.\nAutomatically set by setting `ement-room-message-format-spec',\nbut may be overridden manually.\"\n :type 'boolean)\n\n(defcustom ement-room-unread-only-counts-notifications t\n \"Only use notification counts to mark rooms unread.\nNotification counts are set by the server based on each room's\nnotification settings. Otherwise, whether a room is marked\nunread depends on the room's fully-read marker, read-receipt\nmarker, whether the local user sent the latest events, etc.\"\n :type 'boolean)\n\n(defvar ement-room-sender-in-left-margin nil\n \"Whether sender is shown in left margin.\nSet by `ement-room-message-format-spec-setter'.\")\n\n(defun ement-room-message-format-spec-setter (option value &optional local)\n \"Set relevant options for `ement-room-message-format-spec', which see.\nTo be used as that option's setter. OPTION and VALUE are\nreceived from setting the customization option. If LOCAL is\nnon-nil, set the variables buffer-locally (i.e. when called from\n`ement-room-set-message-format'.\"\n (cl-macrolet ((set-vars (&rest pairs)\n ;; Set variable-value pairs, locally if LOCAL is non-nil.\n `(progn\n ,@(cl-loop for (symbol value) on pairs by #'cddr\n collect `(if local\n (set (make-local-variable ',symbol) ,value)\n (set ',symbol ,value))))))\n (if local\n (set (make-local-variable option) value)\n (set-default option value))\n (pcase value\n ;; Try to set the margin widths smartly.\n (\"%B%r%R%t\" ;; \"Elemental\"\n (set-vars ement-room-left-margin-width 0\n ement-room-right-margin-width 8\n ement-room-sender-headers t\n ement-room-sender-in-headers t\n ement-room-sender-in-left-margin nil))\n (\"%S%L%B%r%R%t\" ;; \"IRC-style using margins\"\n (set-vars ement-room-left-margin-width 12\n ement-room-right-margin-width 8\n ement-room-sender-headers nil\n ement-room-sender-in-headers nil\n ement-room-sender-in-left-margin t))\n (\"[%t] %S> %B%r\" ;; \"IRC-style without margins\"\n (set-vars ement-room-left-margin-width 0\n ement-room-right-margin-width 0\n ement-room-sender-headers nil\n ement-room-sender-in-headers nil\n ement-room-sender-in-left-margin nil))\n (_ (set-vars ement-room-left-margin-width\n (if (string-match-p \"%L\" value)\n 12 0)\n ement-room-right-margin-width\n (if (string-match-p \"%R\" value)\n 8 0)\n ement-room-sender-in-left-margin\n (if (string-match-p (rx (1+ anything) (or \"%S\" \"%s\") (1+ anything) \"%L\") value)\n t nil)\n ;; NOTE: The following two variables may seem redundant, but one is an\n ;; option that the user may override, while the other is set\n ;; automatically.\n ement-room-sender-headers\n (if (string-match-p (or \"%S\" \"%s\") value)\n ;; If \"%S\" or \"%s\" isn't found, assume it's to be shown in headers.\n nil t)\n ement-room-sender-in-headers\n (if (string-match-p (rx (or \"%S\" \"%s\")) value)\n ;; If \"%S\" or \"%s\" isn't found, assume it's to be shown in headers.\n nil t))\n (message \"Ement: When using custom message format, setting margin widths may be necessary\")))\n (unless ement-room-sender-in-headers\n ;; HACK: Disable overline on sender face.\n (require 'face-remap)\n (if local\n (progn\n (face-remap-reset-base 'ement-room-user)\n (face-remap-add-relative 'ement-room-user '(:overline nil)))\n (set-face-attribute 'ement-room-user nil :overline nil)))\n (unless local\n (when (and (bound-and-true-p ement-sessions) (car ement-sessions))\n ;; Only display when a session is connected (not sure why `bound-and-true-p'\n ;; is required to avoid compilation warnings).\n (message \"Ement: Kill and reopen room buffers to display in new format\")))))\n\n(defcustom ement-room-message-format-spec \"%S%L%B%r%R%t\"\n \"Format messages according to this spec.\nIt may contain these specifiers:\n\n %L End of left margin\n %R Start of right margin\n %W End of wrap-prefix\n\n %b Message body (plain-text)\n %B Message body (formatted if available)\n %i Event ID\n %O Room display name (used for mentions buffer)\n %r Reactions\n %s Sender ID\n %S Sender display name\n %t Event timestamp, formatted according to\n `ement-room-timestamp-format'\n\nNote that margin sizes must be set manually with\n`ement-room-left-margin-width' and\n`ement-room-right-margin-width'.\"\n :type '(choice (const :tag \"IRC-style using margins\" \"%S%L%B%r%R%t\")\n (const :tag \"IRC-style without margins\" \"[%t] %S> %B%r\")\n (const :tag \"IRC-style without margins, with wrap-prefix\" \"[%t] %S> %W%B%r\")\n (const :tag \"IRC-style with right margin, with wrap-prefix\" \"%S> %W%B%r%R%t\")\n (const :tag \"Elemental\" \"%B%r%R%t\")\n (string :tag \"Custom format\"))\n :set #'ement-room-message-format-spec-setter\n :set-after '(ement-room-left-margin-width ement-room-right-margin-width\n ement-room-sender-headers)\n ;; This file must be loaded before calling the setter to define the\n ;; `ement-room-user' face used in it.\n :require 'ement-room)\n\n(defcustom ement-room-retro-messages-number 30\n \"Number of messages to retrieve when loading earlier messages.\"\n :type 'integer)\n\n(defcustom ement-room-timestamp-header-format \" %H:%M \"\n \"Format string for timestamp headers where date is unchanged.\nSee function `format-time-string'. If this string ends in a\nnewline, its background color will extend to the end of the\nline.\"\n :type '(choice (const :tag \"Time-only\" \" %H:%M \")\n (const :tag \"Always show date\" \" %Y-%m-%d %H:%M \")\n string))\n\n(defcustom ement-room-timestamp-header-with-date-format \" %Y-%m-%d (%A)\\n\"\n ;; FIXME: In Emacs 27+, maybe use :extend t instead of adding a newline.\n \"Format string for timestamp headers where date changes.\nSee function `format-time-string'. If this string ends in a\nnewline, its background color will extend to the end of the\nline.\"\n :type '(choice (const \" %Y-%m-%d (%A)\\n\")\n string))\n\n(defcustom ement-room-replace-edited-messages t\n \"Replace edited messages with their new content.\nWhen nil, edited messages are displayed as new messages, leaving\nthe original messages visible.\"\n :type 'boolean)\n\n(defcustom ement-room-shr-use-fonts nil\n \"Enable `shr' variable-pitch fonts for formatted bodies.\nIf non-nil, `shr' may use variable-pitch fonts for formatted\nbodies (which include most replies), which means that some\nmessages won't display in the same font as others.\"\n :type '(choice (const :tag \"Disable variable-pitch fonts\" nil)\n (const :tag \"Enable variable-pitch fonts\" t)))\n\n(defcustom ement-room-username-display-property '(raise -0.25)\n \"Display property applied to username strings.\nSee Info node `(elisp)Other Display Specs'.\"\n :type '(choice (list :tag \"Raise\" (const raise :tag \"Raise\") (number :tag \"Factor\"))\n (list :tag \"Height\" (const height)\n (choice (list :tag \"Larger\" (const + :tag \"Larger\") (number :tag \"Steps\"))\n (list :tag \"Smaller\" (const - :tag \"Smaller\") (number :tag \"Steps\"))\n (number :tag \"Factor\")\n (function :tag \"Function\")\n (sexp :tag \"Form\"))) ))\n\n(defcustom ement-room-event-separator-display-property '(space :ascent 50)\n \"Display property applied to invisible space string after events.\nAllows visual separation between events without, e.g. inserting\nnewlines.\n\nSee Info node `(elisp)Specified Space'.\"\n :type 'sexp)\n\n(defcustom ement-room-timestamp-header-delta 600\n \"Show timestamp header where events are at least this many seconds apart.\"\n :type 'integer)\n\n(defcustom ement-room-send-message-filter nil\n \"Function through which to pass message content before sending.\nUsed to, e.g. send an Org-formatted message by exporting it to\nHTML first.\"\n :type '(choice (const :tag \"Send messages as-is\" nil)\n (const :tag \"Send messages in Org format\" ement-room-send-org-filter)\n (function :tag \"Custom filter function\"))\n :set (lambda (option value)\n (set-default option value)\n (pcase value\n ('ement-room-send-org-filter\n ;; Activate in compose buffer by default.\n (add-hook 'ement-room-compose-hook #'ement-room-compose-org))\n (_ (remove-hook 'ement-room-compose-hook #'ement-room-compose-org)))))\n\n(defcustom ement-room-mark-rooms-read t\n \"Mark rooms as read automatically.\nMoves read and fully-read markers in rooms on the server when\n`ement-room-scroll-up-mark-read' is called at the end of a\nbuffer. When `send', also marks room as read when sending a\nmessage in it. When disabled, rooms may still be marked as read\nmanually by calling `ement-room-mark-read'. Note that this is\nnot strictly the same as read receipts.\"\n :type '(choice (const :tag \"When scrolling past end of buffer\" t)\n (const :tag \"Also when sending\" send)\n (const :tag \"Never\" nil)))\n\n(defcustom ement-room-send-typing t\n \"Send typing notifications to the server while typing a message.\"\n :type 'boolean)\n\n(defcustom ement-room-join-view-buffer t\n \"View room buffer when joining a room.\"\n :type 'boolean)\n\n(defcustom ement-room-leave-kill-buffer t\n \"Kill room buffer when leaving a room.\nWhen disabled, the room's buffer will remain open, but\nMatrix-related commands in it will fail.\"\n :type 'boolean)\n\n(defcustom ement-room-warn-for-already-seen-messages nil\n \"Warn when a sent message has already been seen.\nSuch a case could very rarely indicate a reused transaction ID,\nwhich would prevent further messages from being sent (and would\nbe solved by logging in with a new session, generating a new\ntoken), but most often it happens when the server echoes back a\nsent message before acknowledging the sending of the\nmessage (which is harmless and can be ignored).\"\n :type 'boolean)\n\n(defcustom ement-room-wrap-prefix\n (concat (propertize \" \"\n 'face 'ement-room-wrap-prefix)\n \" \")\n \"String prefixing certain events in room buffers.\nEvents include membership events, image attachments, etc.\nGenerally users should prefer to customize the face\n`ement-room-wrap-prefix' rather than this option, because this\noption's default value has that face applied to it where\nappropriate; if users customize this option, they will need to\napply the face to the string themselves, if desired.\"\n :type 'string)\n\n(defgroup ement-room-prism nil\n \"Colorize usernames and messages in rooms.\"\n :group 'ement-room)\n\n(defcustom ement-room-prism 'name\n \"Display users' names and messages in unique colors.\"\n :type '(choice (const :tag \"Name only\" name)\n (const :tag \"Name and message\" both)\n (const :tag \"Neither\" nil)))\n\n(defcustom ement-room-prism-addressee t\n \"Show addressees' names in their respective colors.\nApplies to room member names at the beginning of messages,\npreceded by a colon or comma.\n\nNote that a limitation applies to the current implementation: if\na message from the addressee is not yet visible in a room at the\ntime the addressed message is formatted, the color may not be\napplied.\"\n ;; FIXME: When we keep a hash table of members in a room, make this\n ;; smarter.\n :type 'boolean)\n\n(defcustom ement-room-prism-color-adjustment 0\n \"Number used to tweak computed username colors.\nThis may be used to adjust your favorite users' colors if you\ndon't like the default ones. (The only way to do it is by\nexperimentation--there is no direct mapping available, nor a\nper-user setting.)\n\nThe number is added to the hashed user ID before converting it to\na color. Note that, since user ID hashes are ratioed against\n`most-positive-fixnum', this number must be very large in order\nto have any effect; it should be at least 1e13.\n\nAfter changing this option, a room's buffer must be killed and\nrecreated to see the effect.\"\n :type 'number\n :set (lambda (option value)\n (unless (or (= 0 value) (>= value 1e13))\n (user-error \"This option must be a very large number, at least 1e13\"))\n (set-default option value)))\n\n(defcustom ement-room-prism-minimum-contrast 6\n \"Attempt to enforce this minimum contrast ratio for user faces.\nThis should be a reasonable number from, e.g. 0-7 or so.\"\n ;; Prot would almost approve of this default. :) I would go all the way\n ;; to 7, but 6 already significantly dilutes the colors in some cases.\n :type 'number)\n\n(defcustom ement-room-prism-message-desaturation 25\n \"Desaturate user colors by this percent for message bodies.\nMakes message bodies a bit less intense.\"\n :type 'integer)\n\n(defcustom ement-room-prism-message-lightening 10\n \"Lighten user colors by this percent for message bodies.\nMakes message bodies a bit less intense.\n\nWhen using a light theme, it may be necessary to use a negative\nnumber (to darken rather than lighten).\"\n :type 'integer)\n\n;;;; Macros\n\n(defmacro ement-room-with-highlighted-event-at (position &rest body)\n \"Highlight event at POSITION while evaluating BODY.\"\n ;; MAYBE: Accept a marker for POSITION.\n (declare (indent 1))\n `(let* ((node (ewoc-locate ement-ewoc ,position))\n (event (ewoc-data node))\n ement-room-replying-to-event ement-room-replying-to-overlay)\n (unless (and (ement-event-p event)\n (ement-event-id event))\n (error \"No event at point\"))\n (unwind-protect\n (progn\n (setf ement-room-replying-to-event event\n ement-room-replying-to-overlay\n (make-overlay (ewoc-location node)\n ;; NOTE: It doesn't seem possible to get the end position of\n ;; a node, so if there is no next node, we use point-max.\n ;; But this might break if we were to use an EWOC footer.\n (if (ewoc-next ement-ewoc node)\n (ewoc-location (ewoc-next ement-ewoc node))\n (point-max))))\n (overlay-put ement-room-replying-to-overlay 'face 'highlight)\n ,@body)\n (when (overlayp ement-room-replying-to-overlay)\n (delete-overlay ement-room-replying-to-overlay))\n (setf ement-room-replying-to-event nil\n ement-room-replying-to-overlay nil))))\n\n(defmacro ement-room-with-typing (&rest body)\n \"Send typing notifications around BODY.\nWhen `ement-room-send-typing' is enabled, typing notifications\nare sent while BODY is executing. BODY is wrapped in an\n`unwind-protect' form that cancels `ement-room-typing-timer' and\nsends a not-typing notification.\"\n (declare (indent defun))\n `(unwind-protect\n (progn\n (when ement-room-send-typing\n (when ement-room-typing-timer\n ;; In case there are any stray ones (e.g. a user typing in\n ;; more than room at once, which is possible but unlikely).\n (cancel-timer ement-room-typing-timer))\n (setf ement-room-typing-timer (run-at-time nil 15 #'ement-room--send-typing ement-session ement-room)))\n ,@body)\n (when ement-room-send-typing\n (when ement-room-typing-timer\n (cancel-timer ement-room-typing-timer)\n (setf ement-room-typing-timer nil))\n ;; Cancel typing notifications after sending a message. (The\n ;; spec doesn't say whether this is needed, but it seems to be.)\n (ement-room--send-typing ement-session ement-room :typing nil))))\n\n(defmacro ement-room-wrap-prefix (string-form &rest properties)\n \"Wrap STRING-FORM with `ement-room-wrap-prefix'.\nConcats `ement-room-wrap-prefix' to STRING-FORM and applies it as\nthe `wrap-prefix' property. Also applies any PROPERTIES.\"\n (declare (indent defun))\n `(concat ement-room-wrap-prefix\n (propertize ,string-form\n 'wrap-prefix ement-room-wrap-prefix\n ,@properties)))\n\n(defsubst ement-room--concat-property (string property value &optional append)\n \"Return STRING having concatted VALUE with PROPERTY on it.\nIf APPEND, append it; otherwise prepend. Assumes PROPERTY is\nconstant throughout STRING.\"\n (declare (indent defun))\n (let* ((old-value (get-text-property 0 property string))\n (new-value (if append\n (concat old-value value)\n (concat value old-value))))\n (propertize string property new-value)))\n\n;;;;; Event formatting\n\n;; NOTE: When adding specs, also add them to docstring\n;; for `ement-room-message-format-spec'.\n\n(defvar ement-room-event-formatters nil\n \"Alist mapping characters to event-formatting functions.\nEach function is called with three arguments: the event, the\nroom, and the session. See macro\n`ement-room-define-event-formatter'.\")\n\n(defvar ement-room--format-message-margin-p nil\n \"Set by margin-related event formatters.\")\n\n(defvar ement-room--format-message-wrap-prefix nil\n \"Set by margin-related event formatters.\")\n\n(defmacro ement-room-define-event-formatter (char docstring &rest body)\n \"Define an event formatter for CHAR with DOCSTRING and BODY.\nBODY is wrapped in a lambda form that binds `event', `room', and\n`session', and the lambda is added to the variable\n`ement-room-event-formatters', which see.\"\n (declare (indent defun))\n `(setf (alist-get ,char ement-room-event-formatters nil nil #'equal)\n (lambda (event room session)\n ,docstring\n ,@body)))\n\n(ement-room-define-event-formatter ?L\n \"Text before this is shown in the left margin.\"\n (ignore event room session)\n (setf ement-room--format-message-margin-p t)\n (propertize \" \" 'left-margin-end t))\n\n(ement-room-define-event-formatter ?R\n \"Text after this is shown in the right margin.\"\n (ignore event room session)\n (setf ement-room--format-message-margin-p t)\n (propertize \" \" 'right-margin-start t))\n\n(ement-room-define-event-formatter ?W\n \"Text before this is the length of the event's wrap-prefix.\nThis emulates the effect of using the left margin (the \\\"%L\\\"\nspec) without requiring all events to use the same margin width.\"\n (ignore event room session)\n (setf ement-room--format-message-wrap-prefix t)\n (propertize \" \" 'wrap-prefix-end t))\n\n(ement-room-define-event-formatter ?b\n \"Plain-text body content.\"\n ;; NOTE: `save-match-data' is required around calls to `ement-room--format-message-body'.\n (let ((body (save-match-data\n (ement-room--format-message-body event :formatted-p nil)))\n (face (ement-room--event-body-face event room session)))\n (add-face-text-property 0 (length body) face 'append body)\n (when ement-room-prism-addressee\n (ement-room--add-member-face body room))\n body))\n\n(ement-room-define-event-formatter ?B\n \"Formatted body content (i.e. rendered HTML).\"\n (let ((body (save-match-data\n (ement-room--format-message-body event)))\n (face (ement-room--event-body-face event room session)))\n (add-face-text-property 0 (length body) face 'append body)\n (when ement-room-prism-addressee\n (ement-room--add-member-face body room))\n body))\n\n(ement-room-define-event-formatter ?i\n \"Event ID.\"\n ;; Probably only useful for debugging, so might remove later.\n (ignore room session)\n (ement-event-id event))\n\n(ement-room-define-event-formatter ?o\n \"Room avatar.\"\n (ignore event session)\n (or (alist-get 'room-list-avatar (ement-room-local room)) \"\"))\n\n(ement-room-define-event-formatter ?O\n \"Room display name.\"\n (ignore event session)\n (let ((room-name (propertize (or (ement-room-display-name room)\n (ement--room-display-name room))\n 'face 'ement-room-name\n 'help-echo (or (ement-room-canonical-alias room)\n (ement-room-id room)))))\n ;; HACK: This will probably only be used in the notifications buffers, anyway.\n (when ement-notify-limit-room-name-width\n (setf room-name (truncate-string-to-width room-name ement-notify-limit-room-name-width\n nil nil ement-room-ellipsis)))\n room-name))\n\n;; NOTE: In ?s and ?S, we add nearly-invisible ASCII unit-separator characters (\"\")\n;; to prevent, e.g. `dabbrev-expand' from expanding display names with body text.\n\n(ement-room-define-event-formatter ?s\n \"Sender MXID.\"\n (ignore room session)\n (concat (propertize (ement-user-id (ement-event-sender event))\n 'face 'ement-room-user)\n \"\"))\n\n(ement-room-define-event-formatter ?S\n \"Sender display name.\"\n (ignore session)\n (pcase-let ((sender (ement--format-user (ement-event-sender event) room))\n ((cl-struct ement-room (local (map buffer))) room))\n ;; NOTE: When called from an `ement-notify' function, ROOM may have no buffer. In\n ;; that case, just use the current buffer (which should be a temp buffer used to\n ;; format the event).\n (with-current-buffer (or buffer (current-buffer))\n (when ement-room-sender-in-left-margin\n ;; Sender in left margin: truncate/pad appropriately.\n (setf sender\n (if (< (string-width sender) ement-room-left-margin-width)\n ;; Using :align-to or :width space display properties doesn't\n ;; seem to have any effect in the margin, so we make a string.\n (concat (make-string (- ement-room-left-margin-width (string-width sender))\n ? )\n sender)\n ;; String wider than margin: truncate it.\n (ement-room--concat-property\n (truncate-string-to-width sender ement-room-left-margin-width nil nil \"…\")\n 'help-echo (concat sender \" \"))))))\n ;; NOTE: I'd like to add a help-echo function to display the sender ID, but the Emacs\n ;; manual says that there is currently no way to make text in the margins mouse-sensitive.\n ;; So `ement--format-user' returns a string propertized with `help-echo' as a string.\n (concat sender \"\")))\n\n(ement-room-define-event-formatter ?r\n \"Reactions.\"\n (ignore room session)\n (ement-room--format-reactions event))\n\n(ement-room-define-event-formatter ?t\n \"Timestamp.\"\n (ignore room session)\n (propertize (format-time-string ement-room-timestamp-format ;; Timestamps are in milliseconds.\n (/ (ement-event-origin-server-ts event) 1000))\n 'face 'ement-room-timestamp\n 'help-echo (format-time-string \"%Y-%m-%d %H:%M:%S\"\n (/ (ement-event-origin-server-ts event) 1000))))\n\n(defun ement-room--event-body-face (event room session)\n \"Return face definition for EVENT in ROOM on SESSION.\"\n (ignore room) ;; Unused for now, but keeping for consistency.\n ;; This used to be a macro in --format-message, which is probably better for\n ;; performance, but using a function is clearer, and avoids premature optimization.\n (pcase-let* (((cl-struct ement-event sender\n (content (map msgtype))\n (unsigned (map ('redacted_by unsigned-redacted-by)))\n (local (map ('redacted-by local-redacted-by))))\n event)\n ((cl-struct ement-user (id sender-id)) sender)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user)\n (self-message-p (equal sender-id user-id))\n (type-face (pcase msgtype\n (\"m.emote\" 'ement-room-message-emote)\n (_ 'ement-room-message-text)))\n (context-face (cond (self-message-p\n 'ement-room-self-message)\n ((or (ement-room--event-mentions-user-p event user)\n (ement--event-mentions-room-p event))\n 'ement-room-mention)))\n (prism-color (unless self-message-p\n (when (eq 'both ement-room-prism)\n (or (ement-user-message-color sender)\n (setf (ement-user-message-color sender)\n (let ((message-color (color-desaturate-name (ement--user-color sender)\n ement-room-prism-message-desaturation)))\n (if (ement--color-dark-p (color-name-to-rgb (face-background 'default)))\n (color-lighten-name message-color ement-room-prism-message-lightening)\n (color-darken-name message-color ement-room-prism-message-lightening))))))))\n (redacted-face (when (or local-redacted-by unsigned-redacted-by)\n 'ement-room-redacted))\n (body-face (list :inherit (delq nil (list redacted-face context-face type-face)))))\n (if prism-color\n (plist-put body-face :foreground prism-color)\n body-face)))\n\n(defun ement-room--add-member-face (string room)\n \"Add member faces in ROOM to STRING.\nIf STRING begins with the name of a member in ROOM followed by a\ncolon or comma (as if STRING is a message addressing that\nmember), apply that member's displayname color face to that part\nof the string.\n\nNote that, if ROOM has no buffer, STRING is returned unchanged.\"\n ;; This only looks for a member name at the beginning of the string. It would be neat to add\n ;; colors to every member mentioned in a message, but that would probably not perform well.\n\n ;; NOTE: This function may be called by `ement-notify' functions even when the room has\n ;; no buffer, and this function is designed to use events in a room buffer to more\n ;; quickly find the data it needs, so, for now, if the room has no buffer, we return\n ;; STRING unchanged.\n (pcase-let (((cl-struct ement-room (local (map buffer))) room))\n (if (buffer-live-p buffer)\n (save-match-data\n ;; This function may be called from a chain of others that use the match data, so\n ;; rather than depending on all of them to save the match data, we do it here.\n ;; FIXME: Member names containing spaces aren't matched. Can this even be fixed reasonably?\n (when (string-match (rx bos (group (1+ (not blank))) (or \":\" \",\") (1+ blank)) string)\n (when-let* ((member-name (match-string 1 string))\n ;; HACK: Since we don't currently keep a list of all\n ;; members in a room, we look to see if this displayname\n ;; has any mentions in the room so far.\n (user (save-match-data\n (with-current-buffer buffer\n (save-excursion\n (goto-char (point-min))\n (cl-labels ((found-sender-p\n (ewoc-data)\n (when (ement-event-p ewoc-data)\n (equal member-name\n (gethash (ement-event-sender ewoc-data) (ement-room-displaynames room))))))\n (cl-loop with regexp = (regexp-quote member-name)\n while (re-search-forward regexp nil t)\n ;; NOTE: I don't know why, but sometimes the regexp\n ;; search ends on a non-event line, like a timestamp\n ;; header, so for now we just try to handle that case.\n for maybe-event = (ewoc-data (ewoc-locate ement-ewoc))\n when (found-sender-p maybe-event)\n return (ement-event-sender maybe-event)))))))\n (prism-color (or (ement-user-color user)\n (setf (ement-user-color user)\n (ement-room--user-color user)))))\n (add-face-text-property (match-beginning 1) (match-end 1)\n (list :foreground prism-color) nil string))))\n ;; Room has no buffer: return STRING as-is.\n string)))\n\n;;;; Bookmark support\n\n;; Especially useful with Burly: \n\n(require 'bookmark)\n\n(defun ement-room-bookmark-make-record ()\n \"Return a bookmark record for the current `ement-room' buffer.\"\n (pcase-let* (((cl-struct ement-room (id room-id) canonical-alias display-name) ement-room)\n ((cl-struct ement-session user) ement-session)\n ((cl-struct ement-user (id session-id)) user))\n ;; MAYBE: Support bookmarking specific events in a room.\n (list (concat \"Ement room: \" display-name \" (\" canonical-alias \")\")\n (cons 'session-id session-id)\n (cons 'room-id room-id)\n (cons 'handler #'ement-room-bookmark-handler))))\n\n(defun ement-room-bookmark-handler (bookmark)\n \"Show Ement room buffer for BOOKMARK.\"\n (pcase-let* ((`(,_name . ,(map session-id room-id)) bookmark)\n (session (ement-aprog1\n (alist-get session-id ement-sessions nil nil #'equal)\n (unless it\n ;; MAYBE: Automatically connect.\n (user-error \"Session %s not connected: call `ement-connect' first\" session-id))))\n (room (ement-aprog1\n (ement-afirst (equal room-id (ement-room-id it))\n (ement-session-rooms session))\n (cl-assert it nil \"Room %S not found on session %S\" room-id session-id))))\n (ement-view-room room session)\n ;; HACK: Put point at the end of the room buffer. This seems unusually difficult,\n ;; apparently because the bookmark library itself moves point after jumping to a\n ;; bookmark. My attempts at setting the buffer's and window's points after calling\n ;; `ement-view-room' have had no effect. `bookmark-after-jump-hook' sounds ideal, but\n ;; it does not seem to actually get run, so we use a timer that runs immediately after\n ;; `bookmark-jump' returns.\n (run-at-time nil nil (lambda ()\n (goto-char (point-max))))))\n\n;;;; Commands\n\n(defun ement-room-override-name (name room session)\n \"Set display NAME override for ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room. If NAME is the empty string, remove\nthe override.\n\nSets account-data event of type\n\\\"org.matrix.msc3015.m.room.name.override\\\". This name is only\nused by clients that respect this proposed override. See\n.\"\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Set name override (%s): \" (ement--format-room ement-room)))\n (name (read-string prompt nil nil (ement-room-display-name ement-room))))\n (list name ement-room ement-session))))\n (ement-put-account-data session \"org.matrix.msc3015.m.room.name.override\"\n (if (string-empty-p name)\n ;; `json-encode' wants an empty hash table to represent an empty map. And\n ;; apparently there's no way to DELETE account-data events, so we have to re-PUT\n ;; it with empty content.\n (make-hash-table)\n (ement-alist \"name\" name))\n :room room))\n\n(defun ement-room-flush-colors ()\n \"Flush generated username/message colors.\nAlso, redisplay events in all open buffers. The colors will be\nregenerated according to the current background color. Helpful\nwhen switching themes or adjusting `ement-prism' options.\"\n (interactive)\n (cl-loop for user being the hash-values of ement-users\n do (setf (ement-user-color user) nil\n (ement-user-message-color user) nil))\n (dolist (buffer (buffer-list))\n (when (eq 'ement-room-mode (buffer-local-value 'major-mode buffer))\n (with-current-buffer buffer\n (ewoc-refresh ement-ewoc))))\n ;; Flush notify-background-color colors.\n (cl-loop for (_id . session) in ement-sessions\n do (cl-loop for room in (ement-session-rooms session)\n do (setf (alist-get 'notify-background-color (ement-room-local room)) nil)))\n ;; NOTE: The notifications buffer can't be refreshed because each event is from a\n ;; different room, and the `ement-room' variable is unset in the buffer.\n\n ;; (when-let (buffer (get-buffer \"*Ement Notifications*\"))\n ;; (with-current-buffer buffer\n ;; (ewoc-refresh ement-ewoc)))\n )\n\n(defun ement-room-browse-url (url &rest args)\n \"Browse URL, using Ement for matrix.to URLs when possible.\nOtherwise, fall back to `browse-url'. When called outside of an\n`ement-room' buffer, the variable `ement-session' must be bound\nto the session in which to look for URL's room and event. ARGS\nare passed to `browse-url'.\"\n (interactive)\n (when (string-match ement-room-matrix.to-url-regexp url)\n (let* ((room-id (when (string-prefix-p \"!\" (match-string 1 url))\n (match-string 1 url)))\n (room-alias (when (string-prefix-p \"#\" (match-string 1 url))\n (match-string 1 url)))\n (event-id (match-string 2 url))\n (room (when (or\n ;; Compare with current buffer's room.\n (and room-id (equal room-id (ement-room-id ement-room)))\n (and room-alias (equal room-alias (ement-room-canonical-alias ement-room)))\n ;; Compare with other rooms on session.\n (and room-id (cl-find room-id (ement-session-rooms ement-session)\n :key #'ement-room-id))\n (and room-alias (cl-find room-alias (ement-session-rooms ement-session)\n :key #'ement-room-canonical-alias)))\n ement-room)))\n (if room\n (progn\n ;; Found room in current session: view it and find the event.\n (ement-view-room room ement-session)\n (when event-id\n (ement-room-find-event event-id)))\n ;; Room not joined: offer to join it or load link in browser.\n (pcase-exhaustive (completing-read\n (format \"Room <%s> not joined on current session. Join it, or load link with browser?\"\n (or room-alias room-id))\n '(\"Join room\" \"Load link with browser\") nil t)\n (\"Join room\" (ement-join-room (or room-alias room-id) ement-session\n :then (when event-id\n (lambda (room session)\n (ement-view-room room session)\n (ement-room-find-event event-id)))))\n (\"Load link with browser\" (apply #'browse-url url args)))))))\n\n(defun ement-room-find-event (event-id)\n \"Go to EVENT-ID in current buffer.\"\n (interactive)\n (cl-labels ((goto-event\n (event-id) (progn\n (push-mark)\n (goto-char\n (ewoc-location\n (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal event-id (ement-event-id data))))))))))\n (if (or (cl-find event-id (ement-room-timeline ement-room)\n :key #'ement-event-id :test #'equal)\n (cl-find event-id (ement-room-state ement-room)\n :key #'ement-event-id :test #'equal))\n ;; Found event in timeline: it should be in the EWOC, so go to it.\n (goto-event event-id)\n ;; Event not found in timeline: try to retro-load it.\n (message \"Event %s not seen in current room. Looking in history...\" event-id)\n (let ((room ement-room))\n (ement-room-retro-to ement-room ement-session event-id\n ;; TODO: Add an ELSE argument to `ement-room-retro-to' and use it to give\n ;; a useful error here.\n :then (lambda ()\n (with-current-buffer (alist-get 'buffer (ement-room-local room))\n (goto-event event-id))))))))\n\n(defun ement-room-set-composition-format (&optional localp)\n \"Set message composition format.\nIf LOCALP (interactively, with prefix), set in current room's\nbuffer. Sets `ement-room-send-message-filter'.\"\n (interactive (list current-prefix-arg))\n (let* ((formats (list (cons \"Plain-text\" nil)\n (cons \"Org-mode\" #'ement-room-send-org-filter)))\n (selected-name (completing-read \"Composition format: \" formats nil 'require-match nil nil\n ement-room-send-message-filter))\n (selected-filter (alist-get selected-name formats nil nil #'equal)))\n (if localp\n (setq-local ement-room-send-message-filter selected-filter)\n (setq ement-room-send-message-filter selected-filter))))\n\n(defun ement-room-set-message-format (format-spec)\n \"Set `ement-room-message-format-spec' in current buffer to FORMAT-SPEC.\nInteractively, prompts for the spec using suggested values of the\noption.\"\n (interactive (list (let* ((choices (thread-last\n (get 'ement-room-message-format-spec 'custom-type)\n cdr\n (seq-filter (lambda (it)\n (eq (car it) 'const)))\n (mapcar (lambda (it)\n (cons (nth 2 it) (nth 3 it))))))\n (choice (completing-read \"Format: \" (mapcar #'car choices))))\n (or (alist-get choice choices nil nil #'equal)\n choice))))\n (cl-assert ement-ewoc)\n (ement-room-message-format-spec-setter 'ement-room-message-format-spec format-spec 'local)\n (setf left-margin-width ement-room-left-margin-width\n right-margin-width ement-room-right-margin-width)\n (set-window-margins nil left-margin-width right-margin-width)\n (if ement-room-sender-in-headers\n (ement-room--insert-sender-headers ement-ewoc)\n (ewoc-filter ement-ewoc (lambda (node-data)\n ;; Return non-nil for nodes that should stay.\n (not (ement-user-p node-data)))))\n (ewoc-refresh ement-ewoc))\n\n(defun ement-room-set-topic (session room topic)\n \"Set ROOM's TOPIC on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\"\n (interactive\n (ement-with-room-and-session\n (list ement-session ement-room\n (read-string (format \"New topic (%s): \"\n (ement-room-display-name ement-room))\n (ement-room-topic ement-room) nil nil 'inherit-input-method))))\n (pcase-let* (((cl-struct ement-room (id room-id) display-name) room)\n (endpoint (format \"rooms/%s/state/m.room.topic\" (url-hexify-string room-id)))\n (data (ement-alist \"topic\" topic)))\n (ement-api session endpoint :method 'put :data (json-encode data)\n :then (lambda (_data)\n (message \"Topic set (%s): %s\" display-name topic)))))\n\n(cl-defun ement-room-send-file (file body room session &key (msgtype \"m.file\"))\n \"Send FILE to ROOM on SESSION, using message BODY and MSGTYPE.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\"\n ;; TODO: Support URLs to remote files.\n (interactive\n (ement-with-room-and-session\n (ement-room-with-typing\n (let* ((file (read-file-name (format \"Send file (%s): \" (ement-room-display-name ement-room))\n nil nil 'confirm))\n (body (ement-room-read-string (format \"Message body (%s): \" (ement-room-display-name ement-room))\n (file-name-nondirectory file) nil nil 'inherit-input-method)))\n (list file body ement-room ement-session)))))\n ;; NOTE: The typing notification won't be quite right, because it'll be canceled while waiting\n ;; for the file to upload. It would be awkward to handle that, so this will do for now.\n (when (yes-or-no-p (format \"Upload file %S to room %S? \"\n file (ement-room-display-name room)))\n (pcase-let* ((filename (file-name-nondirectory file))\n (extension (or (file-name-extension file) \"\"))\n (mime-type (mailcap-extension-to-mime extension))\n (data (with-temp-buffer\n ;; NOTE: Using (set-buffer-multibyte nil) doesn't\n ;; seem to be necessary, but I don't know why not.\n (insert-file-contents file)\n (buffer-string)))\n (size (length data)))\n (ement-upload session :data data :filename filename :content-type mime-type\n :then (lambda (data)\n (message \"Uploaded file %S. Sending message...\" file)\n (pcase-let* (((map ('content_uri content-uri)) data)\n ((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"rooms/%s/send/%s/%s\" (url-hexify-string room-id)\n \"m.room.message\" (ement--update-transaction-id session)))\n ;; TODO: Image height/width (maybe not easy to get in Emacs).\n (content (ement-alist \"msgtype\" msgtype\n \"url\" content-uri\n \"body\" body\n \"filename\" filename\n \"info\" (ement-alist \"mimetype\" mime-type\n \"size\" size))))\n (ement-api session endpoint :method 'put :data (json-encode content)\n :then (apply-partially #'ement-room-send-event-callback\n :room room :session session :content content :data))))))))\n\n(defun ement-room-send-image (file body room session)\n \"Send image FILE to ROOM on SESSION, using message BODY.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\"\n ;; TODO: Support URLs to remote files.\n (interactive\n (ement-with-room-and-session\n (ement-room-with-typing\n (let* ((file (read-file-name (format \"Send image file (%s): \" (ement-room-display-name ement-room))\n nil nil 'confirm))\n (body (ement-room-read-string (format \"Message body (%s): \" (ement-room-display-name ement-room))\n (file-name-nondirectory file) nil nil 'inherit-input-method)))\n (list file body ement-room ement-session)))))\n (ement-room-send-file file body room session :msgtype \"m.image\"))\n\n(defun ement-room-dnd-upload-file (uri _action)\n \"Upload the file as specified by URI to the current room.\"\n (when-let ((file (dnd-get-local-file-name uri t)))\n (ement-room-send-file file (file-name-nondirectory file) ement-room ement-session\n :msgtype (if (string-prefix-p \"image/\" (mailcap-file-name-to-mime-type file))\n \"m.image\"\n \"m.file\"))))\n\n(declare-function ement-tabulated-room-list-next-unread \"ement-tabulated-room-list\")\n(declare-function ement-room-list-next-unread \"ement-room-list\")\n(defun ement-room-scroll-up-mark-read ()\n \"Scroll buffer up, marking read and burying when at end.\"\n (interactive)\n (if (= (window-point) (point-max))\n (progn\n ;; At the bottom of the buffer: mark read and show next unread room.\n (when ement-room-mark-rooms-read\n (ement-room-mark-read ement-room ement-session\n :read-event (ewoc-data (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data) (ement-event-p data))))\n :fully-read-event (ewoc-data (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data) (ement-event-p data))))))\n (set-buffer-modified-p nil)\n (if-let ((rooms-window (cl-find-if (lambda (window)\n (member (buffer-name (window-buffer window))\n '(\"*Ement Taxy*\" \"*Ement Rooms*\")))\n (window-list))))\n ;; Rooms buffer already displayed: select its window and move to next unread room.\n (progn\n (select-window rooms-window)\n (funcall (pcase-exhaustive major-mode\n ('ement-tabulated-room-list-mode #'ement-tabulated-room-list-next-unread)\n ('ement-room-list-mode #'ement-room-list-next-unread))))\n ;; Rooms buffer not displayed: bury this room buffer, which should usually\n ;; result in another room buffer or the rooms list buffer being displayed.\n (bury-buffer))\n (when (member major-mode '(ement-tabulated-room-list-mode ement-room-list-mode))\n ;; Back in the room-list buffer: revert it.\n (revert-buffer)))\n ;; Not at the bottom of the buffer: scroll.\n (condition-case _err\n (scroll-up-command)\n (end-of-buffer (set-window-point nil (point-max))))))\n\n(cl-defun ement-room-join (id-or-alias session &key then)\n \"Join room by ID-OR-ALIAS on SESSION.\nTHEN may be a function to call after joining the room (and when\n`ement-room-join-view-buffer' is non-nil, after viewing the room\nbuffer). It receives two arguments, the room and the session.\"\n (interactive (list (read-string \"Join room (ID or alias): \")\n (or ement-session\n (ement-complete-session))))\n (cl-assert id-or-alias) (cl-assert session)\n (unless (string-match-p\n ;; According to tulir in #matrix-dev:matrix.org, \": is not\n ;; allowed in the localpart, all other valid unicode is\n ;; allowed. (user ids and room ids are the same over\n ;; federation). it's mostly a lack of validation in\n ;; synapse (arbitrary unicode isn't intentionally allowed,\n ;; but it's not disallowed either)\". See\n ;; .\n (rx bos (or \"#\" \"!\") (1+ (not (any \":\")))\n \":\" (1+ (or alnum (any \"-.\"))))\n id-or-alias)\n (user-error \"Invalid room ID or alias (use, e.g. \\\"#ROOM-ALIAS:SERVER\\\")\"))\n (let ((endpoint (format \"join/%s\" (url-hexify-string id-or-alias))))\n (ement-api session endpoint :method 'post :data \"\"\n :then (lambda (data)\n ;; NOTE: This generates a symbol and sets its function value to a lambda\n ;; which removes the symbol from the hook, removing itself from the hook.\n ;; TODO: When requiring Emacs 27, use `letrec'.\n (pcase-let* (((map ('room_id room-id)) data)\n (then-fns (delq nil\n (list (when ement-room-join-view-buffer\n (lambda (room session)\n (ement-view-room room session)))\n then)))\n (then-fn-symbol (gensym (format \"ement-join-%s\" id-or-alias)))\n (then-fn (lambda (session)\n (when-let ((room (cl-loop for room in (ement-session-rooms session)\n when (equal room-id (ement-room-id room))\n return room)))\n ;; In case the join event is not in this next sync\n ;; response, make sure the room is found before removing\n ;; the function and joining the room.\n (remove-hook 'ement-sync-callback-hook then-fn-symbol)\n ;; FIXME: Probably need to unintern the symbol.\n (dolist (fn then-fns)\n (funcall fn room session))))))\n (setf (symbol-function then-fn-symbol) then-fn)\n (add-hook 'ement-sync-callback-hook then-fn-symbol)\n (message \"Joined room: %s\" room-id)))\n :else (lambda (plz-error)\n (pcase-let* (((cl-struct plz-error response) plz-error)\n ((cl-struct plz-response status body) response)\n ((map error) (json-read-from-string body)))\n (pcase status\n ((or 403 429) (error \"Unable to join room %s: %s\" id-or-alias error))\n (_ (error \"Unable to join room %s: %s %S\" id-or-alias status plz-error))))))))\n(defalias 'ement-join-room #'ement-room-join)\n\n(defun ement-room-goto-prev ()\n \"Go to the previous message in buffer.\"\n (interactive)\n (if (>= (point) (- (point-max) 2))\n ;; Point is actually on the last event, but it doesn't appear to be: move point to\n ;; the beginning of that event.\n (ewoc-goto-node ement-ewoc (ewoc-locate ement-ewoc))\n ;; Go to previous event.\n (ement-room-goto-next :next-fn #'ewoc-prev)))\n\n(cl-defun ement-room-goto-next (&key (next-fn #'ewoc-next))\n \"Go to the next message in buffer.\nNEXT-FN is passed to `ement-room--ewoc-next-matching', which\nsee.\"\n (interactive)\n (if-let (node (ement-room--ewoc-next-matching ement-ewoc\n (ewoc-locate ement-ewoc) #'ement-event-p next-fn))\n (ewoc-goto-node ement-ewoc node)\n (user-error \"End of events\")))\n\n(defun ement-room-scroll-down-command ()\n \"Scroll down, and load NUMBER earlier messages when at top.\"\n (interactive)\n (condition-case _err\n (scroll-down nil)\n (beginning-of-buffer\n (call-interactively #'ement-room-retro))))\n\n(defun ement-room-mwheel-scroll (event)\n \"Scroll according to EVENT, loading earlier messages when at top.\"\n (interactive \"e\")\n (with-selected-window (posn-window (event-start event))\n (let ((start (window-start)))\n (mwheel-scroll event)\n (when (= start (window-start))\n (call-interactively #'ement-room-retro)))))\n\n;; TODO: Unify these retro-loading functions.\n\n(cl-defun ement-room-retro\n (room session number &key buffer\n (then (apply-partially #'ement-room-retro-callback room session)))\n ;; FIXME: Naming things is hard.\n \"Retrieve NUMBER older messages in ROOM on SESSION.\"\n (interactive (list ement-room ement-session\n (cl-typecase current-prefix-arg\n (null ement-room-retro-messages-number)\n (list (read-number \"Number of messages: \"))\n (number current-prefix-arg))\n :buffer (current-buffer)))\n (unless ement-room-retro-loading\n (pcase-let* (((cl-struct ement-room id prev-batch) room)\n (endpoint (format \"rooms/%s/messages\" (url-hexify-string id))))\n ;; We use a timeout of 30, because sometimes the server can take a while to\n ;; respond, especially if loading, e.g. hundreds or thousands of events.\n (ement-api session endpoint :timeout 30\n :params (list (list \"from\" prev-batch)\n (list \"dir\" \"b\")\n (list \"limit\" (number-to-string number))\n (list \"filter\" (json-encode ement-room-messages-filter)))\n :then then\n :else (lambda (plz-error)\n (when buffer\n (with-current-buffer buffer\n (setf ement-room-retro-loading nil)))\n (signal 'ement-api-error (list (format \"Loading %s earlier messages failed\" number)\n plz-error))))\n (message \"Loading %s earlier messages...\" number)\n (setf ement-room-retro-loading t))))\n\n(cl-defun ement-room-retro-to (room session event-id &key then (batch-size 100) (limit 1000))\n \"Retrieve messages in ROOM on SESSION back to EVENT-ID.\nWhen event is found, call function THEN. Search in batches of\nBATCH-SIZE events up to a total of LIMIT.\"\n (declare (indent defun))\n (cl-assert\n ;; Ensure the event hasn't already been retrieved.\n (not (gethash event-id (ement-session-events session))))\n (let* ((total-retrieved 0)\n ;; TODO: Use letrec someday.\n (callback-symbol (gensym \"ement-room-retro-to-callback-\"))\n (callback (lambda (data)\n (ement-room-retro-callback room session data)\n (if (gethash event-id (ement-session-events session))\n (progn\n (message \"Found event %S\" event-id)\n ;; FIXME: Probably need to unintern the symbol.\n (when then\n (funcall then)))\n ;; FIXME: What if it hits the beginning of the timeline?\n (if (>= (cl-incf total-retrieved batch-size) limit)\n (message \"%s older events retrieved without finding event %S\"\n limit event-id)\n (message \"Looking back for event %S (%s/%s events retrieved)\"\n event-id total-retrieved limit)\n (ement-room-retro room session batch-size\n :buffer (alist-get 'buffer (ement-room-local room))\n :then callback-symbol))))))\n (fset callback-symbol callback)\n (ement-room-retro room session batch-size\n :buffer (alist-get 'buffer (ement-room-local room))\n :then callback-symbol)))\n\n(cl-defun ement-room-retro-to-token (room session from to\n &key (batch-size 100) (limit 1000))\n \"Retrieve messages in ROOM on SESSION back from FROM to TO.\nRetrieve batches of BATCH-SIZE up to total LIMIT. FROM and TO\nare sync batch tokens. Used for, e.g. filling gaps in\n\\\"limited\\\" sync responses.\"\n ;; NOTE: We don't set `ement-room-retro-loading' since the room may\n ;; not have a buffer. This could theoretically allow a user to\n ;; overlap manual scrollback-induced loading of old messages with\n ;; this gap-filling loading, but that shouldn't matter, and probably\n ;; would be very rare, anyway.\n (pcase-let* (((cl-struct ement-room id) room)\n (endpoint (format \"rooms/%s/messages\" (url-hexify-string id)))\n (then\n (lambda (data)\n (ement-room-retro-callback room session data\n :set-prev-batch nil)\n (pcase-let* (((map end chunk) data))\n\t\t ;; HACK: Comparing the END and TO tokens ought to\n\t\t ;; work for determining whether we are done\n\t\t ;; filling, but it isn't (maybe the server isn't\n\t\t ;; returning the TO token as END when there are no\n\t\t ;; more events), so instead we'll check the length\n\t\t ;; of the chunk.\n (unless (< (length chunk) batch-size)\n ;; More pages remain to be loaded.\n (let ((remaining-limit (- limit batch-size)))\n (if (not (> remaining-limit 0))\n ;; FIXME: This leaves a gap if it's larger than 1,000 events.\n ;; Probably, the limit should be configurable, but it would be good\n ;; to find some way to remember the gap and fill it if the user\n ;; scrolls to it later (although that might be very awkward to do).\n (display-warning 'ement-room-retro-to-token\n (format \"Loaded events in %S (%S) without filling gap; not filling further\"\n (ement-room-display-name room)\n (or (ement-room-canonical-alias room)\n (ement-room-id room))))\n\t\t\t ;; FIXME: Remove this message after further testing.\n (message \"Ement: Continuing to fill gap in %S (%S) (remaining limit: %s)\"\n (ement-room-display-name room)\n (or (ement-room-canonical-alias room)\n (ement-room-id room))\n remaining-limit)\n (ement-room-retro-to-token\n room session end to :limit remaining-limit))))))))\n ;; FIXME: Remove this message after further testing.\n (message \"Ement: Filling gap in %S (%S)\"\n\t (ement-room-display-name room)\n (or (ement-room-canonical-alias room)\n (ement-room-id room)))\n (ement-api session endpoint :timeout 30\n :params (list (list \"from\" from)\n (list \"to\" to)\n (list \"dir\" \"b\")\n (list \"limit\" (number-to-string batch-size))\n (list \"filter\" (json-encode ement-room-messages-filter)))\n :then then\n :else (lambda (plz-error)\n (signal 'ement-api-error\n (list (format \"Filling gap in %S (%S) failed\"\n (ement-room-display-name room)\n (or (ement-room-canonical-alias room)\n (ement-room-id room)))\n plz-error))))))\n\n;; NOTE: `declare-function' doesn't recognize cl-defun forms, so this declaration doesn't work.\n(declare-function ement--sync \"ement.el\" t t)\n(defun ement-room-sync (session &optional force)\n \"Sync SESSION (interactively, current buffer's).\nIf FORCE (interactively, with prefix), cancel any outstanding\nsync requests. Also, update any room list buffers.\"\n (interactive (list ement-session current-prefix-arg))\n (ement--sync session :force force)\n (cl-loop for buffer in (buffer-list)\n when (member (buffer-local-value 'major-mode buffer)\n '(ement-room-list-mode ement-tabulated-room-list-mode))\n do (with-current-buffer buffer\n (revert-buffer))))\n\n(defun ement-room-view-event (event)\n \"Pop up buffer showing details of EVENT (interactively, the one at point).\nEVENT should be an `ement-event' or `ement-room-membership-events' struct.\"\n (interactive (list (ewoc-data (ewoc-locate ement-ewoc))))\n (require 'pp)\n (cl-labels ((event-alist\n (event) (ement-alist :id (ement-event-id event)\n :sender (ement-user-id (ement-event-sender event))\n :content (ement-event-content event)\n :origin-server-ts (ement-event-origin-server-ts event)\n :type (ement-event-type event)\n :state-key (ement-event-state-key event)\n :unsigned (ement-event-unsigned event)\n :receipts (ement-event-receipts event)\n :local (ement-event-local event))))\n (let* ((buffer-name (format \"*Ement event: %s*\"\n (cl-typecase event\n (ement-room-membership-events \"[multiple events]\")\n (ement-event (ement-event-id event)))))\n (event (cl-typecase event\n (ement-room-membership-events\n (mapcar #'event-alist (ement-room-membership-events-events event)))\n (ement-event (event-alist event))))\n (inhibit-read-only t))\n (with-current-buffer (get-buffer-create buffer-name)\n (erase-buffer)\n (pp event (current-buffer))\n (view-mode)\n (pop-to-buffer (current-buffer))))))\n\n(cl-defun ement-room-send-message (room session &key body formatted-body replying-to-event)\n \"Send message to ROOM on SESSION with BODY and FORMATTED-BODY.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\n\nREPLYING-TO-EVENT may be an event the message is in reply to; the\nmessage will reference it appropriately.\n\nIf `ement-room-send-message-filter' is non-nil, the message's\ncontent alist is passed through it before sending. This may be\nused to, e.g. process the BODY into another format and add it to\nthe content (e.g. see `ement-room-send-org-filter').\"\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Send message (%s): \" (ement-room-display-name ement-room)))\n (body (ement-room-with-typing\n (ement-room-read-string prompt nil nil nil\n 'inherit-input-method))))\n (list ement-room ement-session :body body))))\n (ement-send-message room session :body body :formatted-body formatted-body\n :replying-to-event replying-to-event :filter ement-room-send-message-filter\n :then #'ement-room-send-event-callback)\n ;; NOTE: This assumes that the selected window is the buffer's window. For now\n ;; this is almost surely the case, but in the future, we might let the function\n ;; send messages to other rooms more easily, so this assumption might not hold.\n (when-let* ((buffer (alist-get 'buffer (ement-room-local room)))\n (window (get-buffer-window buffer)))\n (with-selected-window window\n (when (>= (window-point) (ewoc-location (ewoc-nth ement-ewoc -1)))\n ;; Point is on last event: advance it to eob so that when the event is received\n ;; back, the window will scroll. (This might not always be desirable, because\n ;; the user might have point on that event for a reason, but I think in most\n ;; cases, it will be what's expected and most helpful.)\n (setf (window-point) (point-max))))))\n\n(cl-defun ement-room-send-emote (room session &key body)\n \"Send emote to ROOM on SESSION with BODY.\nInteractively, with prefix, prompt for room and session,\notherwise use current room.\n\nIf `ement-room-send-message-filter' is non-nil, the message's\ncontent alist is passed through it before sending. This may be\nused to, e.g. process the BODY into another format and add it to\nthe content (e.g. see `ement-room-send-org-filter').\"\n (interactive\n (ement-with-room-and-session\n (let* ((prompt (format \"Send emote (%s): \" (ement-room-display-name ement-room)))\n (body (ement-room-with-typing\n (ement-room-read-string prompt nil nil nil\n 'inherit-input-method))))\n (list ement-room ement-session :body body))))\n (cl-assert (not (string-empty-p body)))\n (pcase-let* (((cl-struct ement-room (id room-id) (local (map buffer))) room)\n (window (when buffer (get-buffer-window buffer)))\n (endpoint (format \"rooms/%s/send/m.room.message/%s\" (url-hexify-string room-id)\n (ement--update-transaction-id session)))\n (content (ement-aprog1\n (ement-alist \"msgtype\" \"m.emote\"\n \"body\" body))))\n (when ement-room-send-message-filter\n (setf content (funcall ement-room-send-message-filter content room)))\n (ement-api session endpoint :method 'put :data (json-encode content)\n :then (apply-partially #'ement-room-send-event-callback :room room :session session\n :content content :data)) ;; Data is added when calling back.\n ;; NOTE: This assumes that the selected window is the buffer's window. For now\n ;; this is almost surely the case, but in the future, we might let the function\n ;; send messages to other rooms more easily, so this assumption might not hold.\n (when window\n (with-selected-window window\n (when (>= (window-point) (ewoc-location (ewoc-nth ement-ewoc -1)))\n ;; Point is on last event: advance it to eob so that when the event is received\n ;; back, the window will scroll. (This might not always be desirable, because\n ;; the user might have point on that event for a reason, but I think in most\n ;; cases, it will be what's expected and most helpful.)\n (setf (window-point) (point-max)))))))\n\n(cl-defun ement-room-send-event-callback (&key data room session content)\n \"Callback for event-sending functions.\nDATA is the parsed JSON object. If DATA's event ID is already\npresent in SESSION's events table, show an appropriate warning\nmentioning the ROOM and CONTENT.\"\n (pcase-let* (((map ('event_id event-id)) data))\n (when (and ement-room-warn-for-already-seen-messages\n (gethash event-id (ement-session-events session)))\n (let ((message (format \"Event ID %S already seen in session %S. This may indicate a reused transaction ID, which could mean that the event was not sent to the room (%S). You may need to disconnect, delete the `ement-sessions-file', and connect again to start a new session. Alternatively, this can happen if the event's sent-confirmation is received after the event itself is received in the next sync response, in which case no action is needed.\"\n event-id (ement-user-id (ement-session-user session))\n (ement-room-display-name room))))\n (when content\n (setf message (concat message (format \" Event content: %S\" content))))\n (display-warning 'ement-room-send-event-callback message)))\n (when (eq 'send ement-room-mark-rooms-read)\n ;; Move read markers.\n (when-let ((buffer (alist-get 'buffer (ement-room-local room))))\n (with-current-buffer buffer\n ;; NOTE: The new event may not exist in the buffer yet, so\n ;; we just have to use the last one.\n ;; FIXME: When we add local echo, this can be fixed.\n (save-excursion\n (goto-char (ewoc-location\n (ement-room--ewoc-last-matching ement-ewoc #'ement-event-p)))\n (call-interactively #'ement-room-mark-read)))))))\n\n(defun ement-room-edit-message (event room session body)\n \"Edit EVENT in ROOM on SESSION to have new BODY.\nThe message must be one sent by the local user.\"\n (interactive (ement-room-with-highlighted-event-at (point)\n (cl-assert ement-session) (cl-assert ement-room)\n (pcase-let* ((event (ewoc-data (ewoc-locate ement-ewoc)))\n ((cl-struct ement-session user) ement-session)\n ((cl-struct ement-event sender\n (content (map body ('m.relates_to relates-to))))\n event))\n (unless (equal (ement-user-id sender) (ement-user-id user))\n (user-error \"You may only edit your own messages\"))\n (when relates-to\n ;; FIXME: This isn't quite right. When we show edits by replacing\n ;; the original event, this will need to be changed.\n (user-error \"Only original messages may be edited, not the edit events themselves\"))\n ;; Remove any leading asterisk from the plain-text body.\n (setf body (replace-regexp-in-string (rx bos \"*\" (1+ space)) \"\" body t t))\n (ement-room-with-typing\n (let* ((prompt (format \"Edit message (%s): \"\n (ement-room-display-name ement-room)))\n (body (ement-room-read-string prompt body nil nil\n 'inherit-input-method)))\n (when (string-empty-p body)\n (user-error \"To delete a message, use command `ement-room-delete-message'\"))\n (when (yes-or-no-p (format \"Edit message to: %S? \" body))\n (list event ement-room ement-session body)))))))\n (let* ((endpoint (format \"rooms/%s/send/%s/%s\" (url-hexify-string (ement-room-id room))\n \"m.room.message\" (ement--update-transaction-id session)))\n (new-content (ement-alist \"body\" body\n \"msgtype\" \"m.text\"))\n (_ (when ement-room-send-message-filter\n (setf new-content (funcall ement-room-send-message-filter new-content room))))\n (content (ement-alist \"msgtype\" \"m.text\"\n \"body\" body\n \"m.new_content\" new-content\n \"m.relates_to\" (ement-alist \"rel_type\" \"m.replace\"\n \"event_id\" (ement-event-id event)))))\n ;; Prepend the asterisk after the filter may have modified the content. Note that the\n ;; \"m.new_content\" body does not get the leading asterisk, only the \"content\" body,\n ;; which is intended as a fallback.\n (setf body (concat \"* \" body))\n (ement-api session endpoint :method 'put :data (json-encode content)\n :then (apply-partially #'ement-room-send-event-callback :room room :session session\n :content content :data))))\n\n(defun ement-room-delete-message (event room session &optional reason)\n \"Delete EVENT in ROOM on SESSION, optionally with REASON.\"\n (interactive (ement-room-with-highlighted-event-at (point)\n (if (yes-or-no-p \"Delete this event? \")\n (list (ewoc-data (ewoc-locate ement-ewoc))\n ement-room ement-session (read-string \"Reason (optional): \" nil nil nil 'inherit-input-method))\n ;; HACK: This isn't really an error, but is there a cleaner way to cancel?\n (user-error \"Message not deleted\"))))\n (ement-redact event room session reason))\n\n(defun ement-room-write-reply ()\n \"Send a reply to event at point.\"\n (interactive)\n (cl-assert ement-ewoc) (cl-assert ement-room) (cl-assert ement-session)\n (cl-assert (ement-event-p (ewoc-data (ewoc-locate ement-ewoc))))\n (ement-room-with-highlighted-event-at (point)\n (pcase-let* ((event (ewoc-data (ewoc-locate ement-ewoc)))\n (room ement-room)\n (session ement-session)\n (prompt (format \"Send reply (%s): \" (ement-room-display-name room)))\n (ement-room-read-string-setup-hook\n (lambda ()\n (setq-local ement-room-replying-to-event event)))\n (body (ement-room-with-typing\n (ement-room-read-string prompt nil nil nil 'inherit-input-method))))\n (ement-room-send-message room session :body body :replying-to-event event))))\n\n(defun ement-room-send-reaction (key position)\n \"Send reaction of KEY to event at POSITION.\nInteractively, send reaction to event at point. KEY should be a\nreaction string, e.g. \\\"👍\\\".\"\n (interactive\n (list (char-to-string (read-char-by-name \"Reaction (prepend \\\"*\\\" for substring search): \"))\n (point)))\n ;; SPEC: MSC2677 \n ;; HACK: We could simplify this by storing the key in a text property...\n (ement-room-with-highlighted-event-at position\n (pcase-let* ((event (or (ewoc-data (ewoc-locate ement-ewoc position))\n (user-error \"No event at point\")))\n ;; NOTE: Sadly, `face-at-point' doesn't work here because, e.g. if\n ;; hl-line-mode is enabled, it only returns the hl-line face.\n ((cl-struct ement-event (id event-id)) event)\n ((cl-struct ement-room (id room-id)) ement-room)\n (endpoint (format \"rooms/%s/send/m.reaction/%s\" (url-hexify-string room-id)\n (ement--update-transaction-id ement-session)))\n (content (ement-alist \"m.relates_to\"\n (ement-alist \"rel_type\" \"m.annotation\"\n \"event_id\" event-id\n \"key\" key))))\n (ement-api ement-session endpoint :method 'put :data (json-encode content)\n :then (apply-partially #'ement-room-send-event-callback\n :room ement-room :session ement-session :content content\n :data)))))\n\n(defun ement-room-toggle-reaction (key event room session)\n \"Toggle reaction of KEY to EVENT in ROOM on SESSION.\"\n (interactive\n (cl-labels\n ((face-at-point-p\n (face) (let ((face-at-point (get-text-property (point) 'face)))\n (or (eq face face-at-point)\n (and (listp face-at-point)\n (member face face-at-point)))))\n (buffer-substring-while\n (beg pred &key (forward-fn #'forward-char))\n \"Return substring of current buffer from BEG while PRED is true.\"\n (save-excursion\n (goto-char beg)\n (cl-loop while (funcall pred)\n do (funcall forward-fn)\n finally return (buffer-substring-no-properties beg (point)))))\n (key-at\n (pos) (cond ((face-at-point-p 'ement-room-reactions-key)\n (buffer-substring-while\n pos (lambda () (face-at-point-p 'ement-room-reactions-key))))\n ((face-at-point-p 'ement-room-reactions)\n ;; Point is in a reaction button but after the key.\n (buffer-substring-while\n (button-start (button-at pos))\n (lambda () (face-at-point-p 'ement-room-reactions-key)))))))\n (list (or (key-at (point))\n (char-to-string (read-char-by-name \"Reaction (prepend \\\"*\\\" for substring search): \")))\n (ewoc-data (ewoc-locate ement-ewoc))\n ement-room ement-session)))\n (pcase-let* (((cl-struct ement-event (local (map reactions))) event)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user))\n (if-let (reaction-event (cl-find-if (lambda (event)\n (and (equal user-id (ement-user-id (ement-event-sender event)))\n (equal key (map-nested-elt (ement-event-content event) '(m.relates_to key)))))\n reactions))\n ;; Already sent this reaction: redact it.\n (ement-redact reaction-event room session)\n ;; Send reaction.\n (ement-room-send-reaction key (point)))))\n\n(defun ement-room-reaction-button-action (button)\n \"Push reaction BUTTON at point.\"\n ;; TODO: Toggle reactions off with redactions (not in spec yet, but Element does it).\n (save-excursion\n (goto-char (button-start button))\n (call-interactively #'ement-room-toggle-reaction)))\n\n(defun ement-room-toggle-space (room space session)\n ;; Naming things is hard, but this seems the best balance between concision, ambiguity,\n ;; and consistency. The docstring is always there. (Or there's the sci-fi angle:\n ;; \"spacing\" a room...)\n \"Toggle ROOM's membership in SPACE on SESSION.\"\n (interactive\n (ement-with-room-and-session\n :prompt-form (ement-complete-room :session ement-session\n :predicate (lambda (room) (not (ement--room-space-p room))) )\n (pcase-let* ((prompt (format \"Toggle room %S's membership in space: \"\n (ement--format-room ement-room)))\n ;; TODO: Use different face for spaces the room is already in.\n (`(,space ,_session) (ement-complete-room :session ement-session :prompt prompt :suggest nil\n :predicate #'ement--room-space-p)))\n (list ement-room space ement-session))))\n (pcase-let* (((cl-struct ement-room (id child-id)) room)\n (routing-server (progn\n (string-match (rx (1+ (not (any \":\"))) \":\" (group (1+ anything))) child-id)\n (match-string 1 child-id)))\n (action (if (ement--room-in-space-p room space)\n 'remove 'add))\n (data (pcase action\n ('add (ement-alist \"via\" (vector\n ;; FIXME: Finish and use the routing function.\n ;; (ement--room-routing room)\n routing-server)))\n ('remove (make-hash-table)))))\n (ement-put-state space \"m.space.child\" child-id data session\n :then (lambda (response-data)\n ;; It appears that the server doesn't send the new event in the next sync (at\n ;; least, not to the client that put the state), so we must simulate receiving it.\n (pcase-let* (((map event_id) response-data)\n ((cl-struct ement-session user) session)\n ((cl-struct ement-room (id child-id)) room)\n (fake-event (make-ement-event :id event_id :type \"m.space.child\"\n :sender user :state-key child-id\n :content (json-read-from-string (json-encode data)))))\n (push fake-event (ement-room-timeline space))\n (run-hook-with-args 'ement-event-hook fake-event space session))\n (ement-message \"Room %S %s space %S\"\n (ement--format-room room)\n (pcase action\n ('add \"added to\")\n ('remove \"removed from\"))\n (ement--format-room space))))))\n\n;;;; Functions\n\n(defun ement-room-view (room session)\n \"Switch to a buffer showing ROOM on SESSION.\nUses action `ement-view-room-display-buffer-action', which see.\"\n (interactive (ement-complete-room :session (ement-complete-session) :suggest nil\n :predicate (lambda (room)\n (not (ement--room-space-p room)))))\n (pcase-let* (((cl-struct ement-room (local (map buffer))) room))\n (unless (buffer-live-p buffer)\n (setf buffer (ement-room--buffer session room (ement-room--buffer-name room))\n (alist-get 'buffer (ement-room-local room)) buffer))\n ;; FIXME: This doesn't seem to work as desired, e.g. when\n ;; `ement-view-room-display-buffer-action' is set to `display-buffer-no-window'; I\n ;; guess because `pop-to-buffer' selects a window.\n (pop-to-buffer buffer ement-view-room-display-buffer-action)\n (run-hook-with-args 'ement-room-view-hook room session)))\n(defalias 'ement-view-room #'ement-room-view)\n\n(defun ement-room-view-hook-room-list-auto-update (_room session)\n \"Call `ement-room-list-auto-update' with SESSION.\nTo be used in `ement-room-view-hook', which see.\"\n ;; This function is necessary because the hook is called with the room argument, which\n ;; `ement-room-list-auto-update' doesn't need.\n (declare (function ement-room-list-auto-update \"ement-room-list\"))\n (ement-room-list-auto-update session))\n\n(defun ement-room--buffer-name (room)\n \"Return name for ROOM's buffer.\"\n (concat ement-room-buffer-name-prefix\n (or (ement-room-display-name room)\n (setf (ement-room-display-name room)\n (ement--room-display-name room)))\n ement-room-buffer-name-suffix))\n\n(defun ement-room-goto-event (event)\n \"Go to EVENT in current buffer.\"\n (if-let ((node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal (ement-event-id event) (ement-event-id data)))))))\n (goto-char (ewoc-location node))\n (error \"Event not found in buffer: %S\" (ement-event-id event))))\n\n(cl-defun ement-room-retro-callback (room session data\n &key (set-prev-batch t))\n \"Push new DATA to ROOM on SESSION and add events to room buffer.\nIf SET-PREV-BATCH is nil, don't set ROOM's prev-batch slot to the\n\\\"prev_batch\\\" token in response DATA (this should be set,\ne.g. when filling timeline gaps as opposed to retrieving messages\nbefore the earliest-seen message).\"\n (declare (function ement--make-event \"ement.el\")\n (function ement--put-event \"ement.el\"))\n (pcase-let* (((cl-struct ement-room local) room)\n\t ((map _start end chunk state) data)\n ((map buffer) local)\n (num-events (length chunk))\n ;; We do 3 things for chunk events, so we count them 3 times when\n ;; reporting progress. (We also may receive some state events for\n ;; these chunk events, but we don't bother to include them in the\n ;; count, and we don't report progress for them, because they are\n ;; likely very few compared to the number of timeline events, which is\n ;; what the user is interested in (e.g. when loading 1000 earlier\n ;; messages in #emacs:matrix.org, only 31 state events were received).\n (progress-max-value (* 3 num-events)))\n ;; NOTE: Put the newly retrieved events at the end of the slots, because they should be\n ;; older events. But reverse them first, because we're using \"dir=b\", which the\n ;; spec says causes the events to be returned in reverse-chronological order, and we\n ;; want to process them oldest-first (important because a membership event having a\n ;; user's displayname should be older than a message event sent by the user).\n ;; NOTE: The events in `chunk' and `state' are vectors, so we\n ;; convert them to a list before appending.\n (ement-debug num-events progress-max-value)\n (setf chunk (nreverse chunk)\n state (nreverse state))\n ;; FIXME: Like `ement--push-joined-room-events', this should probably run the `ement-event-hook' on the newly seen events.\n ;; Append state events.\n (cl-loop for event across-ref state\n do (setf event (ement--make-event event))\n finally do (setf (ement-room-state room)\n (append (ement-room-state room) (append state nil))))\n (ement-with-progress-reporter (:reporter (\"Ement: Processing earlier events...\" 0 progress-max-value))\n ;; Append timeline events (in the \"chunk\").\n (cl-loop for event across-ref chunk\n do (setf event (ement--make-event event))\n ;; HACK: Put events on events table. See FIXME above about using the event hook.\n (ement--put-event event nil session)\n (ement-progress-update)\n finally do (setf (ement-room-timeline room)\n (append (ement-room-timeline room) (append chunk nil))))\n (when buffer\n ;; Insert events into the room's buffer.\n (with-current-buffer buffer\n (save-window-excursion\n ;; NOTE: See note in `ement--update-room-buffers'.\n (when-let ((buffer-window (get-buffer-window buffer)))\n (select-window buffer-window))\n ;; FIXME: Use retro-loading in event handlers, or in --handle-events, anyway.\n (ement-room--process-events chunk)\n (when set-prev-batch\n ;; This feels a little hacky, but maybe not too bad.\n (setf (ement-room-prev-batch room) end))\n (setf ement-room-retro-loading nil)))))\n (message \"Ement: Loaded %s earlier events.\" num-events)))\n\n(defun ement-room--insert-events (events &optional retro)\n \"Insert EVENTS into current buffer.\nCalls `ement-room--insert-event' for each event and inserts\ntimestamp headers into appropriate places while maintaining\npoint's position. If RETRO is non-nil, assume EVENTS are earlier\nthan any existing events, and only insert timestamp headers up to\nthe previously oldest event.\"\n (let (buffer-window point-node orig-first-node point-max-p)\n (when (get-buffer-window (current-buffer))\n ;; HACK: See below.\n (setf buffer-window (get-buffer-window (current-buffer))\n point-max-p (= (point) (point-max))))\n (when (and buffer-window retro)\n (setf point-node (ewoc-locate ement-ewoc (window-start buffer-window))\n orig-first-node (ewoc-nth ement-ewoc 0)))\n (save-window-excursion\n ;; NOTE: When inserting some events, seemingly only replies, if a different buffer's\n ;; window is selected, and this buffer's window-point is at the bottom, the formatted\n ;; events may be inserted into the wrong place in the buffer, even though they are\n ;; inserted into the EWOC at the right place. We work around this by selecting the\n ;; buffer's window while inserting events, if it has one. (I don't know if this is a bug\n ;; in EWOC or in this file somewhere. But this has been particularly nasty to debug.)\n (when buffer-window\n (select-window buffer-window))\n (cl-loop for event being the elements of events\n do (ement-room--process-event event)\n do (ement-progress-update)))\n ;; Since events can be received in any order, we have to check the whole buffer\n ;; for where to insert new timestamp headers. (Avoiding that would require\n ;; getting a list of newly inserted nodes and checking each one instead of every\n ;; node in the buffer. Doing that now would probably be premature optimization,\n ;; though it will likely be necessary if users keep buffers open for busy rooms\n ;; for a long time, as the time to do this in each buffer will increase with the\n ;; number of events. At least we only do it once per batch of events.)\n (ement-room--insert-ts-headers nil (when retro orig-first-node))\n (when ement-room-sender-in-headers\n (ement-room--insert-sender-headers ement-ewoc))\n (when buffer-window\n (cond (retro (with-selected-window buffer-window\n (set-window-start buffer-window (ewoc-location point-node))\n ;; TODO: Experiment with this.\n (forward-line -1)))\n (point-max-p (set-window-point buffer-window (point-max)))))))\n\n(cl-defun ement-room--send-typing (session room &key (typing t))\n \"Send a typing notification for ROOM on SESSION.\"\n (pcase-let* (((cl-struct ement-session user) session)\n ((cl-struct ement-user (id user-id)) user)\n ((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"rooms/%s/typing/%s\"\n (url-hexify-string room-id) (url-hexify-string user-id)))\n (data (ement-alist \"typing\" typing \"timeout\" 20000)))\n (ement-api session endpoint :method 'put :data (json-encode data)\n ;; We don't really care about the response, I think.\n :then #'ignore)))\n\n(define-derived-mode ement-room-mode fundamental-mode\n `(\"Ement-Room\"\n (:eval (unless (map-elt ement-syncs ement-session)\n (propertize \":Not-syncing\"\n 'face 'font-lock-warning-face\n 'help-echo \"Automatic syncing was interrupted; press \\\"g\\\" to resume\"))))\n \"Major mode for Ement room buffers.\nThis mode initializes a buffer to be used for showing events in\nan Ement room. It kills all local variables, removes overlays,\nand erases the buffer.\"\n (let ((inhibit-read-only t))\n (erase-buffer))\n (remove-overlays)\n (setf buffer-read-only t\n left-margin-width ement-room-left-margin-width\n right-margin-width ement-room-right-margin-width\n imenu-create-index-function #'ement-room--imenu-create-index-function\n ;; TODO: Use EWOC header/footer for, e.g. typing messages.\n ement-ewoc (ewoc-create #'ement-room--pp-thing))\n ;; Set the URL handler. Note that `browse-url-handlers' was added in 28.1;\n ;; prior to that `browse-url-browser-function' served double-duty.\n ;; TODO: Remove compat code when requiring Emacs >=28.\n (let ((handler (cons ement-room-matrix.to-url-regexp #'ement-room-browse-url)))\n (if (boundp 'browse-url-handlers)\n (setq-local browse-url-handlers (cons handler browse-url-handlers))\n (setq-local browse-url-browser-function\n (cons handler\n (if (consp browse-url-browser-function)\n browse-url-browser-function\n (and browse-url-browser-function\n (list (cons \".\" browse-url-browser-function))))))))\n (setq-local completion-at-point-functions\n '(ement-room--complete-members-at-point ement-room--complete-rooms-at-point)) \n (setq-local dnd-protocol-alist (append '((\"^file:///\" . ement-room-dnd-upload-file)\n (\"^file:\" . ement-room-dnd-upload-file))\n dnd-protocol-alist)))\n(add-hook 'ement-room-mode-hook 'visual-line-mode)\n\n(defun ement-room-read-string (prompt &optional initial-input history default-value inherit-input-method)\n \"Call `read-from-minibuffer', binding variables and keys for Ement.\nArguments PROMPT, INITIAL-INPUT, HISTORY, DEFAULT-VALUE, and\nINHERIT-INPUT-METHOD are as those expected by `read-string',\nwhich see. Runs hook `ement-room-read-string-setup-hook', which\nsee.\"\n (let ((room ement-room)\n (session ement-session))\n (minibuffer-with-setup-hook\n (lambda ()\n \"Bind keys and variables locally (to be called in minibuffer).\"\n (setq-local ement-room room)\n (setq-local ement-session session)\n (setq-local completion-at-point-functions\n '(ement-room--complete-members-at-point ement-room--complete-rooms-at-point))\n (visual-line-mode 1)\n (run-hooks 'ement-room-read-string-setup-hook))\n (read-from-minibuffer prompt initial-input ement-room-minibuffer-map\n nil history default-value inherit-input-method))))\n\n(defun ement-room--buffer (session room name)\n \"Return buffer named NAME showing ROOM's events on SESSION.\nIf ROOM has no buffer, one is made and stored in the room's local\ndata slot.\"\n (or (map-elt (ement-room-local room) 'buffer)\n (let ((new-buffer (generate-new-buffer name)))\n (with-current-buffer new-buffer\n (ement-room-mode)\n (setf header-line-format (when ement-room-header-line-format\n 'ement-room-header-line-format)\n ement-session session\n ement-room room\n list-buffers-directory (or (ement-room-canonical-alias room)\n (ement-room-id room))\n ;; Track buffer in room's slot.\n (map-elt (ement-room-local room) 'buffer) (current-buffer))\n (add-hook 'kill-buffer-hook\n (lambda ()\n (setf (map-elt (ement-room-local room) 'buffer) nil))\n nil 'local)\n (setq-local bookmark-make-record-function #'ement-room-bookmark-make-record)\n ;; Set initial header and footer. (Do this before processing events, which\n ;; might cause the header/footer to be changed (e.g. a tombstone event).\n (let ((header (if (cl-loop for state in (list (ement-room-state ement-room)\n (ement-room-invite-state ement-room))\n thereis (cl-find \"m.room.encryption\" state\n :test #'equal :key #'ement-event-type))\n (propertize \"This appears to be an encrypted room, which is not natively supported by Ement.el. (See information about using Pantalaimon in Ement.el documentation.)\"\n 'face 'font-lock-warning-face)\n \"\"))\n (footer (pcase (ement-room-status ement-room)\n ;; Set header and footer for an invited room.\n ('invite\n (concat (propertize \"You've been invited to this room. \"\n 'face 'font-lock-warning-face)\n (propertize \"[Join this room]\"\n 'button '(t)\n 'category 'default-button\n 'mouse-face 'highlight\n 'follow-link t\n 'action (lambda (_button)\n ;; Kill the room buffer so it can be recreated after joining\n ;; (which will cleanly update the room's name, footer, etc).\n (let ((room ement-room)\n (session ement-session))\n (kill-buffer)\n (message \"Joining room... (buffer will be reopened after joining)\")\n (ement-room-join (ement-room-id room) session))))))\n (_ \"\"))))\n (ewoc-set-hf ement-ewoc header footer))\n (setf\n ;; Clear new-events, because those only matter when a buffer is already open.\n (alist-get 'new-events (ement-room-local room)) nil\n ;; Set the new buffer in the room's local alist so that it\n ;; can be used by event-inserting functions before this\n ;; function returns, e.g. `ement-room--add-member-face'.\n (alist-get 'buffer (ement-room-local room)) new-buffer)\n ;; We don't use `ement-room--insert-events' to avoid extra\n ;; calls to `ement-room--insert-ts-headers'.\n ;; NOTE: We handle the events in chronological order (i.e. the reverse of the\n ;; stored order, which is latest-first), because some logic depends on this\n ;; (e.g. processing a message-edit event before the edited event would mean the\n ;; edited event would not yet be in the buffer).\n (ement-room--process-events (reverse (ement-room-state room)))\n (ement-room--process-events (reverse (ement-room-timeline room)))\n (ement-room--insert-ts-headers)\n (when ement-room-sender-in-headers\n (ement-room--insert-sender-headers ement-ewoc))\n (ement-room-move-read-markers room\n :read-event (when-let ((event (alist-get \"m.read\" (ement-room-account-data room) nil nil #'equal)))\n (map-nested-elt event '(content event_id)))\n :fully-read-event (when-let ((event (alist-get \"m.fully_read\" (ement-room-account-data room) nil nil #'equal)))\n (map-nested-elt event '(content event_id)))))\n ;; Return the buffer!\n new-buffer)))\n\n(defun ement-room--event-data (id)\n \"Return event struct for event ID in current buffer.\"\n ;; Search from bottom, most likely to be faster.\n (cl-loop with node = (ewoc-nth ement-ewoc -1)\n while node\n for data = (ewoc-data node)\n when (and (ement-event-p data)\n (equal id (ement-event-id data)))\n return data\n do (setf node (ewoc-prev ement-ewoc node))))\n\n(defun ement-room--escape-% (string)\n \"Return STRING with \\\"%\\\" escaped.\nNeeded to display things in the header line.\"\n (replace-regexp-in-string (rx \"%\") \"%%\" string t t))\n\n;;;;; Imenu\n\n(defconst ement-room-timestamp-header-imenu-format \"%Y-%m-%d (%A) %H:%M\"\n \"Format string for timestamps in Imenu indexes.\")\n\n(defun ement-room--imenu-create-index-function ()\n \"Return Imenu index for the current buffer.\nFor use as `imenu-create-index-function'.\"\n (let ((timestamp-nodes (ement-room--ewoc-collect-nodes\n ement-ewoc (lambda (node)\n (pcase (ewoc-data node)\n (`(ts . ,_) t))))))\n (cl-loop for node in timestamp-nodes\n collect (pcase-let*\n ((`(ts ,timestamp) (ewoc-data node))\n (formatted (format-time-string ement-room-timestamp-header-imenu-format timestamp)))\n (cons formatted (ewoc-location node))))))\n\n;;;;; Occur\n\n(defvar-local ement-room-occur-pred nil\n \"Predicate used to refresh `ement-room-occur' buffers.\")\n\n(define-derived-mode ement-room-occur-mode ement-room-mode \"Ement-Room-Occur\")\n\n(progn\n (define-key ement-room-occur-mode-map [remap ement-room-send-message] #'ement-room-occur-find-event)\n (define-key ement-room-occur-mode-map (kbd \"g\") #'revert-buffer)\n (define-key ement-room-occur-mode-map (kbd \"n\") #'ement-room-occur-next)\n (define-key ement-room-occur-mode-map (kbd \"p\") #'ement-room-occur-prev))\n\n(cl-defun ement-room-occur (&key user-id regexp pred header)\n \"Show known events in current buffer matching args in a new buffer.\nIf REGEXP, show events whose sender or body content match it. Or\nif USER-ID, show events from that user. Or if PRED, show events\nmatching it. HEADER is used if given, or set according to other\narguments.\"\n (interactive (let* ((regexp (read-regexp \"Regexp (leave empty to select user instead)\"))\n (user-id (when (string-empty-p regexp)\n (ement-complete-user-id))))\n (list :regexp regexp :user-id user-id)))\n (let* ((session ement-session)\n (room ement-room)\n (occur-buffer (get-buffer-create (format \"*Ement Room Occur: %s*\" (ement-room-display-name room))))\n (pred (cond (pred)\n ((not (string-empty-p regexp))\n (lambda (data)\n (and (ement-event-p data)\n (or (string-match regexp (ement-user-id (ement-event-sender data)))\n (when-let ((room-display-name\n (gethash (ement-event-sender data) (ement-room-displaynames room))))\n (string-match regexp room-display-name))\n (when-let ((body (alist-get 'body (ement-event-content data))))\n (string-match regexp body))))))\n (user-id\n (lambda (data)\n (and (ement-event-p data)\n (equal user-id (ement-user-id (ement-event-sender data))))))))\n (header (cond (header)\n ((not (string-empty-p regexp))\n (format \"Events matching %S in %s\" regexp (ement-room-display-name room)))\n (user-id\n (format \"Events from %s in %s\" user-id (ement-room-display-name room))))))\n (with-current-buffer occur-buffer\n (let ((inhibit-read-only t))\n (erase-buffer))\n (ement-room-occur-mode)\n (setf header-line-format header\n ement-session session\n ement-room room)\n (setq-local revert-buffer-function (lambda (&rest _)\n (interactive)\n (let ((event-at-point (ewoc-data (ewoc-locate ement-ewoc))))\n (with-current-buffer (alist-get 'buffer (ement-room-local room))\n (ement-room-occur :pred pred :header header)\n (when-let ((node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (eq event-at-point data)))))\n (ewoc-goto-node ement-ewoc node))))))\n (ement-room--process-events (reverse (ement-room-state room)))\n (ement-room--process-events (reverse (ement-room-timeline room)))\n (ewoc-filter ement-ewoc pred)\n ;; TODO: Insert date header before first event.\n (ement-room--insert-ts-headers))\n (pop-to-buffer occur-buffer)))\n\n(defun ement-room-occur-find-event (event)\n \"Find EVENT in room's main buffer.\"\n (interactive (list (ewoc-data (ewoc-locate ement-ewoc))))\n (pcase-let* (((cl-struct ement-room (local (map buffer))) ement-room)\n ((cl-struct ement-event id) event))\n (display-buffer buffer)\n (with-selected-window (get-buffer-window buffer)\n (ement-room-find-event id))))\n\n(cl-defun ement-room-occur-next (&optional (n 1))\n \"Go to Nth next event.\"\n (interactive)\n (let ((command (if (> n 0)\n #'ement-room-goto-next\n #'ement-room-goto-prev)))\n (cl-loop for i below (abs n)\n do (call-interactively command))\n (ement-room-occur-find-event (ewoc-data (ewoc-locate ement-ewoc)))))\n\n(cl-defun ement-room-occur-prev (&optional (n 1))\n \"Go to Nth previous event.\"\n (interactive)\n (ement-room-occur-next (- n)))\n\n;;;;; Events\n\n;; Functions to handle types of events.\n\n;; NOTE: At the moment, this only handles \"m.typing\" ephemeral events. Message\n;; events are handled elsewhere. A better framework should be designed...\n;; TODO: Define other handlers this way.\n\n;; MAYBE: Should we intern these functions? That means every event\n;; handled has to concat and intern. Should we use lambdas in an\n;; alist or hash-table instead? For now let's use an alist.\n\n(defvar ement-users)\n\n(defvar ement-room-event-fns nil\n \"Alist mapping event types to functions which process events in room buffers.\")\n\n;; NOTE: While transitioning to the defevent-based handler system, we\n;; define both a handle-events and handle-event function that do the\n;; same thing.\n\n;; TODO: Tidy this up.\n\n;; NOTE: --handle-events and --handle-event need to be called in the room\n;; buffer's window, when it has one. This is absolutely necessary,\n;; otherwise the events may be inserted at the wrong place. (I'm not\n;; sure if this is a bug in EWOC or in my code, but doing this fixes it.)\n\n(defun ement-room--process-events (events)\n \"Process EVENTS in current buffer.\nCalls `ement-progress-update' for each event. Calls\n`ement-room--insert-ts-headers' when done. Uses handlers defined\nin `ement-room-event-fns'. The current buffer should be a room's\nbuffer.\"\n ;; FIXME: Calling `ement-room--insert-ts-headers' is convenient, but it\n ;; may also be called in functions that call this function, which may\n ;; result in it being called multiple times for a single set of events.\n (cl-loop for event being the elements of events ;; EVENTS may be a list or array.\n for handler = (alist-get (ement-event-type event) ement-room-event-fns nil nil #'equal)\n when handler\n do (funcall handler event)\n do (ement-progress-update))\n (ement-room--insert-ts-headers))\n\n(defun ement-room--process-event (event)\n \"Process EVENT in current buffer.\nUses handlers defined in `ement-room-event-fns'. The current\nbuffer should be a room's buffer.\"\n (when-let ((handler (alist-get (ement-event-type event) ement-room-event-fns nil nil #'equal)))\n ;; We demote any errors that happen while processing events, because it's possible for\n ;; events to be malformed in unexpected ways, and that could cause an error, which\n ;; would stop processing of other events and prevent further syncing. See,\n ;; e.g. .\n (with-demoted-errors \"Ement (ement-room--process-event): Error processing event: %S\"\n (funcall handler event))))\n\n;;;;;; Event handlers\n\n(defmacro ement-room-defevent (type &rest body)\n \"Define an event handling function for events of TYPE.\nAround the BODY, the variable `event' is bound to the event being\nprocessed. The function is called in the room's buffer. Adds\nfunction to `ement-room-event-fns', which see.\"\n (declare (debug (stringp def-body))\n (indent defun))\n `(setf (alist-get ,type ement-room-event-fns nil nil #'string=)\n (lambda (event)\n ,(concat \"`ement-room' handler function for \" type \" events.\")\n ,@body)))\n\n(ement-room-defevent \"m.reaction\"\n (pcase-let* (((cl-struct ement-event content) event)\n ((map ('m.relates_to relates-to)) content)\n ((map ('event_id related-id) ('rel_type rel-type) _key) relates-to))\n ;; TODO: Handle other rel_types?\n (pcase rel-type\n (\"m.annotation\"\n ;; Look for related event in timeline.\n (if-let ((related-event (cl-loop with fake-event = (make-ement-event :id related-id)\n for timeline-event in (ement-room-timeline ement-room)\n when (ement--events-equal-p fake-event timeline-event)\n return timeline-event)))\n ;; Found related event: add reaction to local slot and invalidate node.\n (progn\n ;; Every time a room buffer is made, these reaction events are processed again, so we use pushnew to\n ;; avoid duplicates. (In the future, as event-processing is refactored, this may not be necessary.)\n (cl-pushnew event (map-elt (ement-event-local related-event) 'reactions))\n (when-let ((nodes (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal related-id (ement-event-id data)))))))\n (ewoc-invalidate ement-ewoc nodes)))\n ;; No known related event: discard.\n ;; TODO: Is this the correct thing to do?\n (ement-debug \"No known related event for\" event))))))\n\n(ement-room-defevent \"m.room.power_levels\"\n (ement-room--insert-event event))\n\n(defun ement-room--format-power-levels-event (event room _session)\n \"Return power-levels EVENT in ROOM formatted as a string.\"\n (pcase-let (((cl-struct ement-event sender\n (content (map ('users new-users)))\n (unsigned (map ('prev_content (map ('users old-users))))))\n event))\n (when old-users\n (pcase-let* ((sender-id (ement-user-id sender))\n (sender-displayname (ement--user-displayname-in room sender))\n (`(,changed-user-id-symbol . ,new-level)\n (cl-find-if (lambda (new-user)\n (let ((old-user (cl-find (car new-user) old-users\n :key #'car)))\n (or (not old-user)\n (not (equal (cdr new-user) (cdr old-user))))))\n new-users))\n (changed-user-id (symbol-name changed-user-id-symbol))\n (changed-user (when changed-user-id-symbol\n (gethash changed-user-id ement-users)))\n (user-displayname (if changed-user\n (ement--user-displayname-in room changed-user)\n changed-user-id)))\n (ement-room-wrap-prefix\n (if (not changed-user)\n (format \"%s sent a power-level event\"\n (propertize sender-displayname\n 'help-echo sender-id))\n (format \"%s set %s's power level to %s\"\n (propertize sender-displayname\n 'help-echo sender-id)\n (propertize user-displayname 'help-echo changed-user-id)\n new-level))\n 'face 'ement-room-membership)))))\n\n(ement-room-defevent \"m.room.canonical_alias\"\n (ement-room--insert-event event))\n\n(defun ement-room--format-canonical-alias-event (event room _session)\n \"Return canonical alias EVENT in ROOM formatted as a string.\"\n (pcase-let (((cl-struct ement-event sender\n ;; TODO: Include alt_aliases, maybe.\n ;; TODO: Include old alias when it is being replaced.\n (content (map alias)))\n event))\n (ement-room-wrap-prefix\n (format \"%s set the canonical alias to <%s>\"\n (propertize (ement--user-displayname-in room sender)\n 'help-echo (ement-user-id sender))\n alias)\n 'face 'ement-room-membership)))\n\n(ement-room-defevent \"m.room.redaction\"\n ;; We handle redaction events here rather than an `ement-defevent' handler. This way we\n ;; do less work for events in rooms that the user isn't looking at, at the cost of doing\n ;; a bit more work when a room's buffer is prepared.\n (pcase-let* (((cl-struct ement-event (local (map ('redacts redacted-id)))) event)\n ((cl-struct ement-room timeline) ement-room)\n (redacted-event (cl-find redacted-id timeline\n :key #'ement-event-id :test #'equal)))\n (when redacted-event\n (pcase-let* (((cl-struct ement-event (content\n (map ('m.relates_to\n (map ('event_id related-id)\n ('rel_type rel-type))))))\n redacted-event))\n ;; Record the redaction in the redacted event's local slot.\n (cl-pushnew event (alist-get 'redacted-by (ement-event-local redacted-event)))\n (pcase rel-type\n (\"m.annotation\"\n ;; Redacted annotation/reaction. NOTE: Since we link annotations in a -room\n ;; event handler (rather than in a non-room handler), we also unlink redacted\n ;; ones here.\n (when-let (annotated-event (cl-find related-id timeline\n :key #'ement-event-id :test #'equal))\n ;; Remove it from the related event's local slot.\n (setf (map-elt (ement-event-local annotated-event) 'reactions)\n (cl-remove redacted-id (map-elt (ement-event-local annotated-event) 'reactions)\n :key #'ement-event-id :test #'equal))\n ;; Invalidate the related event's node.\n (when-let (node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal related-id (ement-event-id data))))))\n (ewoc-invalidate ement-ewoc node)))))\n ;; Invalidate the redacted event's node.\n (when-let (node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal redacted-id (ement-event-id data))))))\n (ewoc-invalidate ement-ewoc node))))))\n\n(ement-room-defevent \"m.typing\"\n (pcase-let* (((cl-struct ement-session user) ement-session)\n ((cl-struct ement-user (id local-user-id)) user)\n ((cl-struct ement-event content) event)\n ((map ('user_ids user-ids)) content)\n (usernames) (footer))\n (setf user-ids (delete local-user-id user-ids))\n (if (zerop (length user-ids))\n (setf footer \"\")\n (setf usernames (cl-loop for id across user-ids\n for user = (gethash id ement-users)\n if user\n collect (ement--user-displayname-in ement-room user)\n else collect id)\n footer (propertize (concat \"Typing: \" (string-join usernames \", \"))\n 'face 'font-lock-comment-face)))\n (with-silent-modifications\n (ewoc-set-hf ement-ewoc \"\" footer))))\n\n(ement-room-defevent \"m.room.avatar\"\n (ement-room--insert-event event))\n\n(ement-room-defevent \"org.matrix.msc3015.m.room.name.override\"\n (ignore event)\n (setf (ement-room-display-name ement-room) (ement--room-display-name ement-room))\n (rename-buffer (ement-room--buffer-name ement-room)))\n\n(ement-room-defevent \"m.room.member\"\n (with-silent-modifications\n (ement-room--insert-event event)))\n\n(ement-room-defevent \"m.room.message\"\n (pcase-let* (((cl-struct ement-event content unsigned) event)\n ((map ('m.relates_to (map ('rel_type rel-type) ('event_id replaces-event-id)))) content)\n ((map ('m.relations (map ('m.replace (map ('event_id replaced-by-id)))))) unsigned))\n (if (and ement-room-replace-edited-messages\n replaces-event-id (equal \"m.replace\" rel-type))\n ;; Event replaces existing event: find and replace it in buffer if possible, otherwise insert it.\n (or (ement-room--replace-event event)\n (progn\n (ement-debug \"Unable to replace event ID: inserting instead.\" replaces-event-id)\n (ement-room--insert-event event)))\n ;; New event.\n (if replaced-by-id\n (ement-debug \"Event replaced: not inserting.\" replaced-by-id)\n ;; Not replaced: insert it.\n (ement-room--insert-event event)))))\n\n(ement-room-defevent \"m.room.tombstone\"\n (pcase-let* (((cl-struct ement-event content) event)\n ((map body ('replacement_room new-room-id)) content)\n (session ement-session)\n (button (ement--button-buttonize\n (propertize new-room-id 'help-echo \"Join replacement room\")\n (lambda (_)\n (ement-room-join new-room-id session))))\n (banner (format \"This room has been replaced. Explanation:%S Replacement room: <%s>\" body button)))\n (add-face-text-property 0 (length banner) 'font-lock-warning-face t banner)\n ;; NOTE: We assume that no more typing events will be received,\n ;; which would replace the footer.\n (ement-room--insert-event event)\n (ewoc-set-hf ement-ewoc banner banner)))\n\n;;;;; Read markers\n\n;; Marking rooms as read and showing lines where marks are.\n\n(ement-room-defevent \"m.read\"\n (ement-room-move-read-markers ement-room\n :read-event (ement-event-id event)))\n\n(ement-room-defevent \"m.fully_read\"\n (ement-room-move-read-markers ement-room\n :fully-read-event (ement-event-id event)))\n\n(defvar-local ement-room-read-receipt-marker nil\n \"EWOC node for the room's read-receipt marker.\")\n\n(defvar-local ement-room-fully-read-marker nil\n \"EWOC node for the room's fully-read marker.\")\n\n(defface ement-room-read-receipt-marker\n '((t (:inherit show-paren-match)))\n \"Read marker line in rooms.\")\n\n(defface ement-room-fully-read-marker\n '((t (:inherit isearch)))\n \"Fully read marker line in rooms.\")\n\n(defcustom ement-room-send-read-receipts t\n \"Whether to send read receipts.\nAlso controls whether the read-receipt marker in a room is moved\nautomatically.\"\n :type 'boolean\n :group 'ement-room)\n\n(defun ement-room-read-receipt-idle-timer ()\n \"Update read receipts in visible Ement room buffers.\nTo be called from timer stored in\n`ement-read-receipt-idle-timer'.\"\n (when ement-room-send-read-receipts\n (dolist (window (window-list))\n (when (and (eq 'ement-room-mode (buffer-local-value 'major-mode (window-buffer window)))\n (buffer-local-value 'ement-room (window-buffer window)))\n (ement-room-update-read-receipt window)))))\n\n(defun ement-room-update-read-receipt (window)\n \"Update read receipt for room displayed in WINDOW.\nAlso, mark room's buffer as unmodified.\"\n (with-selected-window window\n (let ((read-receipt-node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (node-data)\n (eq 'ement-room-read-receipt-marker node-data))))\n (window-end-node (or (ewoc-locate ement-ewoc (window-end nil t))\n (ewoc-nth ement-ewoc -1))))\n (when (or\n ;; The window's end has been scrolled to or past the position of the\n ;; receipt marker.\n (and read-receipt-node\n (>= (window-end nil t) (ewoc-location read-receipt-node)))\n ;; The read receipt is outside of retrieved events.\n (not read-receipt-node))\n (let* ((event-node (when window-end-node\n ;; It seems like `window-end-node' shouldn't ever be nil,\n ;; but just in case...\n (cl-typecase (ewoc-data window-end-node)\n (ement-event window-end-node)\n (t (ement-room--ewoc-next-matching ement-ewoc window-end-node\n #'ement-event-p #'ewoc-prev)))))\n (node-after-event (ewoc-next ement-ewoc event-node))\n (event))\n (when event-node\n (unless (or (when node-after-event\n (<= (ewoc-location node-after-event) (window-end nil t)))\n (>= (window-end) (point-max)))\n ;; The entire event is not visible: use the previous event. (NOTE: This\n ;; isn't quite perfect, because apparently `window-end' considers a position\n ;; visible if even one pixel of its line is visible. This will have to be\n ;; good enough for now.)\n ;; FIXME: Workaround that an entire line's height need not be displayed for it to be considered so.\n (setf event-node (ement-room--ewoc-next-matching ement-ewoc event-node\n #'ement-event-p #'ewoc-prev)))\n (setf event (ewoc-data event-node))\n ;; Mark the buffer as not modified so that will not contribute to its being\n ;; considered unread. NOTE: This will mean that any room buffer displayed in\n ;; a window will have its buffer marked unmodified when this function is\n ;; called. This is probably for the best.\n (set-buffer-modified-p nil)\n (unless (alist-get event ement-room-read-receipt-request)\n ;; No existing request for this event: cancel any outstanding request and\n ;; send a new one.\n (when-let ((request-process (car (map-values ement-room-read-receipt-request))))\n (when (process-live-p request-process)\n (interrupt-process request-process)))\n (setf ement-room-read-receipt-request nil)\n (setf (alist-get event ement-room-read-receipt-request)\n (ement-room-mark-read ement-room ement-session\n :read-event event)))))))))\n\n(defun ement-room-goto-fully-read-marker ()\n \"Move to the fully-read marker in the current room.\"\n (interactive)\n (if-let ((fully-read-pos (when ement-room-fully-read-marker\n (ewoc-location ement-room-fully-read-marker))))\n (setf (point) fully-read-pos (window-start) fully-read-pos)\n ;; Unlike the fully-read marker, there doesn't seem to be a\n ;; simple way to get the user's read-receipt marker. So if\n ;; we haven't seen either marker in the retrieved events, we\n ;; go back to the fully-read marker.\n (if-let* ((fully-read-event (alist-get \"m.fully_read\" (ement-room-account-data ement-room) nil nil #'equal))\n (fully-read-event-id (map-nested-elt fully-read-event '(content event_id))))\n ;; Fully-read account-data event is known.\n (if (gethash fully-read-event-id (ement-session-events ement-session))\n ;; The fully-read event (i.e. the message event that was read, not the\n ;; account-data event) is already retrieved, but the marker is not present in\n ;; the buffer (this shouldn't happen, but somehow, it can): Reset the marker,\n ;; which should work around the problem.\n (ement-room-mark-read ement-room ement-session\n :fully-read-event (gethash fully-read-event-id (ement-session-events ement-session)))\n ;; Fully-read event not retrieved: search for it in room history.\n (let ((buffer (current-buffer)))\n (message \"Searching for first unread event...\")\n (ement-room-retro-to ement-room ement-session fully-read-event-id\n :then (lambda ()\n (with-current-buffer buffer\n ;; HACK: Should probably call this function elsewhere, in a hook or something.\n (ement-room-move-read-markers ement-room)\n (ement-room-goto-fully-read-marker))))))\n (error \"Room has no fully-read event\"))))\n\n(cl-defun ement-room-mark-read (room session &key read-event fully-read-event)\n \"Mark ROOM on SESSION as read on the server.\nSet \\\"m.read\\\" to READ-EVENT and \\\"m.fully_read\\\" to\nFULLY-READ-EVENT. Return the API request.\n\nInteractively, mark both types as read up to event at point.\"\n (declare (indent defun))\n (interactive\n (progn\n (cl-assert (equal 'ement-room-mode major-mode) nil\n \"This command is to be used in `ement-room-mode' buffers\")\n (let* ((node (ewoc-locate ement-ewoc))\n (event-at-point (cl-typecase (ewoc-data node)\n (ement-event (ewoc-data node))\n (t (when-let ((prev-event-node (ement-room--ewoc-next-matching ement-ewoc node\n #'ement-event-p #'ewoc-prev)))\n (ewoc-data prev-event-node)))))\n (last-event (ewoc-data (ement-room--ewoc-last-matching ement-ewoc #'ement-event-p)))\n (event-to-mark-read (if (eq event-at-point last-event)\n ;; The node is at the end of the buffer: use the last event in the timeline\n ;; instead of the last node in the EWOC, because the last event in the timeline\n ;; might not be the last event in the EWOC (e.g. a reaction to an earlier event).\n (car (ement-room-timeline ement-room))\n event-at-point)))\n (list ement-room ement-session\n :read-event event-to-mark-read\n :fully-read-event event-to-mark-read))))\n (cl-assert room) (cl-assert session) (cl-assert (or read-event fully-read-event))\n (if (not fully-read-event)\n ;; Sending only a read receipt, which uses a different endpoint\n ;; than when setting the fully-read marker or both.\n (ement-room-send-receipt room session read-event)\n ;; Setting the fully-read marker, and maybe the \"m.read\" one too.\n (pcase-let* (((cl-struct ement-room (id room-id)) room)\n (endpoint (format \"rooms/%s/read_markers\" (url-hexify-string room-id)))\n (data (ement-alist \"m.fully_read\" (ement-event-id fully-read-event))))\n (when read-event\n (push (cons \"m.read\" (ement-event-id read-event)) data))\n ;; NOTE: See similar code in `ement-room-update-read-receipt'.\n (let ((request-process (ement-api session endpoint :method 'post :data (json-encode data)\n :then (lambda (_data)\n (ement-room-move-read-markers room\n :read-event read-event :fully-read-event fully-read-event))\n :else (lambda (plz-error)\n (pcase (plz-error-message plz-error)\n (\"curl process interrupted\"\n ;; Ignore this, because it happens when we\n ;; update a read marker before the previous\n ;; update request is completed.\n nil)\n (_ (signal 'ement-api-error\n (list (format \"Ement: (ement-room-mark-read) Unexpected API error: %s\"\n plz-error)\n plz-error))))))))\n (when-let ((room-buffer (alist-get 'buffer (ement-room-local room))))\n ;; NOTE: Ideally we would do this before sending the new request, but to make\n ;; the code much simpler, we do it afterward.\n (with-current-buffer room-buffer\n (when-let ((request-process (car (map-values ement-room-read-receipt-request))))\n (when (process-live-p request-process)\n (interrupt-process request-process)))\n (setf ement-room-read-receipt-request nil\n (alist-get read-event ement-room-read-receipt-request) request-process)))))))\n\n(cl-defun ement-room-send-receipt (room session event &key (type \"m.read\"))\n \"Send receipt of TYPE for EVENT to ROOM on SESSION.\"\n (pcase-let* (((cl-struct ement-room (id room-id)) room)\n ((cl-struct ement-event (id event-id)) event)\n (endpoint (format \"rooms/%s/receipt/%s/%s\"\n (url-hexify-string room-id) type\n (url-hexify-string event-id))))\n (ement-api session endpoint :method 'post :data \"{}\"\n :then (pcase type\n (\"m.read\" (lambda (_data)\n (ement-room-move-read-markers room\n :read-event event)))\n ;; No other type is yet specified.\n (_ #'ignore)))))\n\n(cl-defun ement-room-move-read-markers\n (room &key\n (read-event (when-let ((event (alist-get \"m.read\" (ement-room-account-data room) nil nil #'equal)))\n (map-nested-elt event '(content event_id))))\n (fully-read-event (when-let ((event (alist-get \"m.fully_read\" (ement-room-account-data room) nil nil #'equal)))\n (map-nested-elt event '(content event_id)))))\n \"Move read markers in ROOM to READ-EVENT and FULLY-READ-EVENT.\nEach event may be an `ement-event' struct or an event ID. This\nupdates the markers in ROOM's buffer, not on the server; see\n`ement-room-mark-read' for that.\"\n (declare (indent defun))\n (cl-labels ((update-marker (symbol to-event)\n (let* ((old-node (symbol-value symbol))\n (new-event-id (cl-etypecase to-event\n (ement-event (ement-event-id to-event))\n (string to-event)))\n (event-node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (and (ement-event-p data)\n (equal (ement-event-id data) new-event-id)))))\n (inhibit-read-only t))\n (with-silent-modifications\n (when old-node\n (ewoc-delete ement-ewoc old-node))\n (set symbol (when event-node\n ;; If the event hasn't been inserted into the buffer yet,\n ;; this might be nil. That shouldn't happen, but...\n (ewoc-enter-after ement-ewoc event-node symbol)))))))\n (when-let ((buffer (alist-get 'buffer (ement-room-local room))))\n ;; MAYBE: Error if no buffer? Or does it matter?\n (with-current-buffer buffer\n (when read-event\n (update-marker 'ement-room-read-receipt-marker read-event))\n (when fully-read-event\n (update-marker 'ement-room-fully-read-marker fully-read-event))))\n ;; NOTE: Return nil so that, in the event this function is called manually with `eval-expression',\n ;; it does not cause an error due to the return value being an EWOC node, which is a structure too\n ;; big and/or circular to print. (This was one of those bugs that only happens WHEN debugging.)\n nil))\n\n;;;;; EWOC\n\n(cl-defun ement-room--ewoc-next-matching (ewoc node pred &optional (move-fn #'ewoc-next))\n \"Return the next node in EWOC after NODE that PRED is true of.\nPRED is called with node's data. Moves to next node by MOVE-FN.\"\n (declare (indent defun))\n (cl-loop do (setf node (funcall move-fn ewoc node))\n until (or (null node)\n (funcall pred (ewoc-data node)))\n finally return node))\n\n(defun ement-room--ewoc-last-matching (ewoc predicate)\n \"Return the last node in EWOC matching PREDICATE.\nPREDICATE is called with node's data. Searches backward from\nlast node.\"\n (declare (indent defun))\n ;; Intended to be like `ewoc-collect', but returning as soon as a match is found.\n (cl-loop with node = (ewoc-nth ewoc -1)\n while node\n when (funcall predicate (ewoc-data node))\n return node\n do (setf node (ewoc-prev ewoc node))))\n\n(defun ement-room--ewoc-collect-nodes (ewoc predicate)\n \"Collect all nodes in EWOC matching PREDICATE.\nPREDICATE is called with the full node.\"\n ;; Intended to be like `ewoc-collect', but working with the full node instead of just the node's data.\n (cl-loop with node = (ewoc-nth ewoc 0)\n do (setf node (ewoc-next ewoc node))\n while node\n when (funcall predicate node)\n collect node))\n\n(defun ement-room--insert-ts-headers (&optional start-node end-node)\n \"Insert timestamp headers into current buffer's `ement-ewoc'.\nInserts headers between START-NODE and END-NODE, which default to\nthe first and last nodes in the buffer, respectively.\"\n (let* ((type-predicate (lambda (node-data)\n (and (ement-event-p node-data)\n (not (equal \"m.room.member\" (ement-event-type node-data))))))\n (ewoc ement-ewoc)\n (end-node (or end-node\n (ewoc-nth ewoc -1)))\n (end-pos (if end-node\n (ewoc-location end-node)\n ;; HACK: Trying to work around a bug in case the\n ;; room doesn't seem to have any events yet.\n (point-max)))\n (node-b (or start-node (ewoc-nth ewoc 0)))\n node-a)\n ;; On the first loop iteration, node-a is set to the first matching\n ;; node after node-b; then it's set to the first node after node-a.\n (while (and (setf node-a (ement-room--ewoc-next-matching ewoc (or node-a node-b) type-predicate)\n node-b (when node-a\n (ement-room--ewoc-next-matching ewoc node-a type-predicate)))\n (not (or (> (ewoc-location node-a) end-pos)\n (when node-b\n (> (ewoc-location node-b) end-pos)))))\n (cl-labels ((format-event\n (event) (format \"TS:%S (%s) Sender:%s Message:%S\"\n (/ (ement-event-origin-server-ts (ewoc-data event)) 1000)\n (format-time-string \"%Y-%m-%d %H:%M:%S\"\n (/ (ement-event-origin-server-ts (ewoc-data event)) 1000))\n (ement-user-id (ement-event-sender (ewoc-data event)))\n (when (alist-get 'body (ement-event-content (ewoc-data event)))\n (substring-no-properties\n (truncate-string-to-width (alist-get 'body (ement-event-content (ewoc-data event))) 20))))))\n (ement-debug \"Comparing event timestamps:\"\n (list 'A (format-event node-a))\n (list 'B (format-event node-b))))\n ;; NOTE: Matrix timestamps are in milliseconds.\n (let* ((a-ts (/ (ement-event-origin-server-ts (ewoc-data node-a)) 1000))\n (b-ts (/ (ement-event-origin-server-ts (ewoc-data node-b)) 1000))\n (diff-seconds (- b-ts a-ts))\n (ement-room-timestamp-header-format ement-room-timestamp-header-format))\n (when (and (>= diff-seconds ement-room-timestamp-header-delta)\n (not (when-let ((node-after-a (ewoc-next ewoc node-a)))\n (pcase (ewoc-data node-after-a)\n (`(ts . ,_) t)\n ((or 'ement-room-read-receipt-marker 'ement-room-fully-read-marker) t)))))\n (unless (equal (time-to-days a-ts) (time-to-days b-ts))\n ;; Different date: bind format to print date.\n (let ((ement-room-timestamp-header-format ement-room-timestamp-header-with-date-format))\n ;; Insert the date-only header.\n (setf node-a (ewoc-enter-after ewoc node-a (list 'ts b-ts)))))\n (with-silent-modifications\n ;; Avoid marking a buffer as modified just because we inserted a ts\n ;; header (this function may be called after other events which shouldn't\n ;; cause it to be marked modified, like moving the read markers).\n (ewoc-enter-after ewoc node-a (list 'ts b-ts))))))))\n\n(cl-defun ement-room--insert-sender-headers\n (ewoc &optional (start-node (ewoc-nth ewoc 0)) (end-node (ewoc-nth ewoc -1)))\n ;; TODO: Use this in appropriate places.\n \"Insert sender headers into EWOC.\nInserts headers between START-NODE and END-NODE, which default to\nthe first and last nodes in the buffer, respectively.\"\n (cl-labels ((read-marker-p\n (data) (member data '(ement-room-fully-read-marker\n ement-room-read-receipt-marker)))\n (message-event-p\n (data) (and (ement-event-p data)\n (equal \"m.room.message\" (ement-event-type data))))\n (insert-sender-before\n (node) (ewoc-enter-before ewoc node (ement-event-sender (ewoc-data node)))))\n (let* ((event-node (if (ement-event-p (ewoc-data start-node))\n start-node\n (ement-room--ewoc-next-matching ewoc start-node\n #'ement-event-p)))\n (prev-node (when event-node\n ;; Just in case...\n (ewoc-prev ewoc event-node))))\n (while (and event-node\n ;; I don't like looking up the location of these nodes on every loop\n ;; iteration, but it seems like the only reliable way to determine\n ;; whether we've reached the end node. However, when this function is\n ;; called for short batches of events (or even a single event, like when\n ;; called from `ement-room--insert-event'), the overhead should be\n ;; minimal.\n (<= (ewoc-location event-node) (ewoc-location end-node)))\n (when (message-event-p (ewoc-data event-node))\n (if (not prev-node)\n ;; No previous node and event is a message: insert header.\n (insert-sender-before event-node)\n ;; Previous node exists.\n (when (read-marker-p (ewoc-data prev-node))\n ;; Previous node is a read marker: we want to act as if they don't exist, so\n ;; we set `prev-node' to the non-marker node before it.\n (setf prev-node (ement-room--ewoc-next-matching ewoc prev-node\n (lambda (data)\n (not (read-marker-p data)))\n #'ewoc-prev)))\n (when prev-node\n ;; A previous node still exists: maybe we need to add a header.\n (cl-typecase (ewoc-data prev-node)\n (ement-event\n ;; Previous node is an event.\n (when (and (message-event-p (ewoc-data prev-node))\n (not (equal (ement-event-sender (ewoc-data prev-node))\n (ement-event-sender (ewoc-data event-node)))))\n ;; Previous node is a message event with a different sender: insert\n ;; header.\n (insert-sender-before event-node)))\n ((or ement-user ement-room-membership-events)\n ;; Previous node is a user or coalesced membership events: do not insert\n ;; header.\n nil)\n (t\n ;; Previous node is not an event and not a read marker: insert header.\n (insert-sender-before event-node))))))\n (setf event-node (ement-room--ewoc-next-matching ewoc event-node\n #'ement-event-p)\n prev-node (when event-node\n (ewoc-prev ewoc event-node)))))))\n\n(defun ement-room--coalesce-nodes (a b ewoc)\n \"Try to coalesce events in nodes A and B in EWOC.\nReturn absorbing node if coalesced.\"\n (cl-labels ((coalescable-p\n (node) (or (and (ement-event-p (ewoc-data node))\n (member (ement-event-type (ewoc-data node)) '(\"m.room.member\")))\n (ement-room-membership-events-p (ewoc-data node)))))\n (when (and (coalescable-p a) (coalescable-p b))\n (let* ((absorbing-node (if (or (ement-room-membership-events-p (ewoc-data a))\n (not (ement-room-membership-events-p (ewoc-data b))))\n a b))\n (absorbed-node (if (eq absorbing-node a) b a)))\n (cl-etypecase (ewoc-data absorbing-node)\n (ement-room-membership-events nil)\n (ement-event (setf (ewoc-data absorbing-node) (ement-room-membership-events--update\n (make-ement-room-membership-events\n :events (list (ewoc-data absorbing-node)))))))\n (push (ewoc-data absorbed-node) (ement-room-membership-events-events (ewoc-data absorbing-node)))\n (ement-room-membership-events--update (ewoc-data absorbing-node))\n (ewoc-delete ewoc absorbed-node)\n (ewoc-invalidate ewoc absorbing-node)\n absorbing-node))))\n\n(defun ement-room--insert-event (event)\n \"Insert EVENT into current buffer.\"\n (cl-labels ((format-event\n (event) (format \"TS:%S (%s) Sender:%s Message:%S\"\n (/ (ement-event-origin-server-ts event) 1000)\n (format-time-string \"%Y-%m-%d %H:%M:%S\"\n (/ (ement-event-origin-server-ts event) 1000))\n (ement-user-id (ement-event-sender event))\n (when (alist-get 'body (ement-event-content event))\n (substring-no-properties\n (truncate-string-to-width (alist-get 'body (ement-event-content event)) 20)))))\n (find-node-if\n (ewoc pred &key (move #'ewoc-prev) (start (ewoc-nth ewoc -1)))\n \"Return node in EWOC whose data matches PRED.\nSearch starts from node START and moves by NEXT.\"\n (cl-loop for node = start then (funcall move ewoc node)\n while node\n when (funcall pred (ewoc-data node))\n return node))\n (timestamped-node-p (data)\n (pcase data\n ((pred ement-event-p) t)\n ((pred ement-room-membership-events-p) t)\n (`(ts . ,_) t)))\n (node-ts (data)\n (pcase data\n ((pred ement-event-p) (ement-event-origin-server-ts data))\n ((pred ement-room-membership-events-p)\n ;; Not sure whether to use earliest or latest ts; let's try this for now.\n (ement-room-membership-events-earliest-ts data))\n (`(ts ,ts)\n ;; Matrix server timestamps are in ms, so we must convert back.\n (* 1000 ts))))\n (node< (a b)\n \"Return non-nil if event A's timestamp is before B's.\"\n (< (node-ts a) (node-ts b))))\n (ement-debug \"INSERTING NEW EVENT: \" (format-event event))\n (let* ((ewoc ement-ewoc)\n (event-node-before (ement-room--ewoc-node-before ewoc event #'node< :pred #'timestamped-node-p))\n new-node)\n ;; HACK: Insert after any read markers.\n (cl-loop for node-after-node-before = (ewoc-next ewoc event-node-before)\n while node-after-node-before\n while (not (ement-event-p (ewoc-data node-after-node-before)))\n do (setf event-node-before node-after-node-before))\n (setf new-node (if (not event-node-before)\n (progn\n (ement-debug \"No event before it: add first.\")\n (if-let ((first-node (ewoc-nth ewoc 0)))\n (progn\n (ement-debug \"EWOC not empty.\")\n (if (and (ement-user-p (ewoc-data first-node))\n (equal (ement-event-sender event)\n (ewoc-data first-node)))\n (progn\n (ement-debug \"First node is header for this sender: insert after it, instead.\")\n (setf event-node-before first-node)\n (ewoc-enter-after ewoc first-node event))\n (ement-debug \"First node is not header for this sender: insert first.\")\n (ewoc-enter-first ewoc event)))\n (ement-debug \"EWOC empty: add first.\")\n (ewoc-enter-first ewoc event)))\n (ement-debug \"Found event before new event: insert after it.\")\n (when-let ((next-node (ewoc-next ewoc event-node-before)))\n (when (and (ement-user-p (ewoc-data next-node))\n (equal (ement-event-sender event)\n (ewoc-data next-node)))\n (ement-debug \"Next node is header for this sender: insert after it, instead.\")\n (setf event-node-before next-node)))\n (ement-debug \"Inserting after event\"\n ;; NOTE: `format-event' is only for debugging, and it\n ;; doesn't handle user headers, so commenting it out or now.\n ;; (format-event (ewoc-data event-node-before))\n\n ;; NOTE: And it's *Very Bad* to pass the raw node data\n ;; to `ement-debug', because it makes event insertion\n ;; *Very Slow*. So we just comment that out for now.\n ;; (ewoc-data event-node-before)\n )\n (ewoc-enter-after ewoc event-node-before event)))\n (when ement-room-coalesce-events\n ;; Try to coalesce events.\n ;; TODO: Move this to a separate function and call it from where this function is called.\n (setf new-node (or (when event-node-before\n (ement-room--coalesce-nodes event-node-before new-node ewoc))\n (when (ewoc-next ewoc new-node)\n (ement-room--coalesce-nodes new-node (ewoc-next ewoc new-node) ewoc))\n new-node)))\n (when ement-room-sender-in-headers\n (ement-room--insert-sender-headers ewoc new-node new-node))\n ;; Return new node.\n new-node)))\n\n(defun ement-room--replace-event (new-event)\n \"Replace appropriate event with NEW-EVENT in current buffer.\nIf replaced event is not found, return nil, otherwise non-nil.\"\n (let* ((ewoc ement-ewoc)\n (old-event-node (ement-room--ewoc-last-matching ewoc\n (lambda (data)\n (cl-typecase data\n (ement-event (ement--events-equal-p data new-event)))))))\n (when old-event-node\n ;; TODO: Record old events in new event's local data, and make it accessible when inspecting the new event.\n (let ((node-before (ewoc-prev ewoc old-event-node))\n (inhibit-read-only t))\n (ewoc-delete ewoc old-event-node)\n (if node-before\n (ewoc-enter-after ewoc node-before new-event)\n (ewoc-enter-first ewoc new-event))))))\n\n(cl-defun ement-room--ewoc-node-before (ewoc data <-fn\n &key (from 'last) (pred #'identity))\n \"Return node in EWOC that matches PRED and belongs before DATA by <-FN.\nSearch from FROM (either `first' or `last').\"\n (cl-assert (member from '(first last)))\n (if (null (ewoc-nth ewoc 0))\n (ement-debug \"EWOC is empty: returning nil.\")\n (ement-debug \"EWOC has data: add at appropriate place.\")\n (cl-labels ((next-matching\n (ewoc node next-fn pred) (cl-loop do (setf node (funcall next-fn ewoc node))\n until (or (null node)\n (funcall pred (ewoc-data node)))\n finally return node)))\n (let* ((next-fn (pcase from ('first #'ewoc-next) ('last #'ewoc-prev)))\n (start-node (ewoc-nth ewoc (pcase from ('first 0) ('last -1)))))\n (unless (funcall pred (ewoc-data start-node))\n (setf start-node (next-matching ewoc start-node next-fn pred)))\n (if (funcall <-fn (ewoc-data start-node) data)\n (progn\n (ement-debug \"New data goes before start node.\")\n start-node)\n (ement-debug \"New data goes after start node: find node before new data.\")\n (let ((compare-node start-node))\n (cl-loop while (setf compare-node (next-matching ewoc compare-node next-fn pred))\n until (funcall <-fn (ewoc-data compare-node) data)\n finally return (if compare-node\n (progn\n (ement-debug \"Found place: enter there.\")\n compare-node)\n (ement-debug \"Reached end of collection: insert there.\")\n (pcase from\n ('first (ewoc-nth ewoc -1))\n ('last nil))))))))))\n\n;;;;; Formatting\n\n(defun ement-room--pp-thing (thing)\n \"Pretty-print THING.\nTo be used as the pretty-printer for `ewoc-create'. THING may be\nan `ement-event' or `ement-user' struct, or a list like `(ts\nTIMESTAMP)', where TIMESTAMP is a Unix timestamp number of\nseconds.\"\n ;; TODO: Use handlers to insert so e.g. membership events can be inserted silently.\n\n ;; TODO: Use `cl-defmethod' and define methods for each of these THING types. (I've\n ;; benchmarked thoroughly and found no difference in performance between using\n ;; `cl-defmethod' and using a `defun' with `pcase', so as long as the `cl-defmethod'\n ;; specializer is sufficient, I see no reason not to use it.)\n (pcase-exhaustive thing\n ((pred ement-event-p)\n (insert \"\" (ement-room--format-event thing ement-room ement-session)))\n ((pred ement-user-p)\n (insert (propertize (ement--format-user thing)\n 'display ement-room-username-display-property)))\n (`(ts ,(and (pred numberp) ts)) ;; Insert a date header.\n (let* ((string (format-time-string ement-room-timestamp-header-format ts))\n (width (string-width string))\n (maybe-newline (if (equal ement-room-timestamp-header-format ement-room-timestamp-header-with-date-format)\n ;; HACK: Rather than using another variable, compare the format strings to\n ;; determine whether the date is changing: if so, add a newline before the header.\n (progn\n (cl-incf width 3)\n \"\\n\")\n \"\"))\n (alignment-space (pcase ement-room-timestamp-header-align\n ('right (propertize \" \"\n 'display `(space :align-to (- text ,(1+ width)))))\n ('center (propertize \" \"\n 'display `(space :align-to (- center ,(/ (1+ width) 2)))))\n (_ \" \"))))\n (insert maybe-newline\n alignment-space\n (propertize string\n 'face 'ement-room-timestamp-header))))\n ((or 'ement-room-read-receipt-marker 'ement-room-fully-read-marker)\n (insert (propertize \" \"\n 'display '(space :width text :height (1))\n 'face thing)))\n ((pred ement-room-membership-events-p)\n (let ((formatted-events (ement-room--format-membership-events thing ement-room)))\n (add-face-text-property 0 (length formatted-events)\n 'ement-room-membership 'append formatted-events)\n (insert (ement-room-wrap-prefix formatted-events))))))\n\n;; (defun ement-room--format-event (event)\n;; \"Format `ement-event' EVENT.\"\n;; (pcase-let* (((cl-struct ement-event sender type content origin-server-ts) event)\n;; ((map body format ('formatted_body formatted-body)) content)\n;; (ts (/ origin-server-ts 1000)) ; Matrix timestamps are in milliseconds.\n;; (body (if (not formatted-body)\n;; body\n;; (pcase format\n;; (\"org.matrix.custom.html\"\n;; (ement-room--render-html formatted-body))\n;; (_ (format \"[unknown formatted-body format: %s] %s\" format body)))))\n;; (timestamp (propertize\n;; \" \" 'display `((margin left-margin)\n;; ,(propertize (format-time-string ement-room-timestamp-format ts)\n;; 'face 'ement-room-timestamp))))\n;; (body-face (pcase type\n;; (\"m.room.member\" 'ement-room-membership)\n;; (_ (if (equal (ement-user-id sender)\n;; (ement-user-id (ement-session-user ement-session)))\n;; 'ement-room-self-message 'default))))\n;; (string (pcase type\n;; (\"m.room.message\" body)\n;; (\"m.room.member\" \"\")\n;; (_ (format \"[unknown event-type: %s] %s\" type body)))))\n;; (add-face-text-property 0 (length body) body-face 'append body)\n;; (prog1 (concat timestamp string)\n;; ;; Hacky or elegant? We return the string, but for certain event\n;; ;; types, we also insert a widget (this function is called by\n;; ;; EWOC with point at the insertion position). Seems to work...\n;; (pcase type\n;; (\"m.room.member\"\n;; (widget-create 'ement-room-membership\n;; :button-face 'ement-room-membership\n;; :value (list (alist-get 'membership content))))))))\n\n(defun ement-room--format-event (event room session)\n \"Return EVENT in ROOM on SESSION formatted.\nFormats according to `ement-room-message-format-spec', which see.\"\n (concat (pcase (ement-event-type event)\n ;; TODO: Define these with a macro, like the defevent and format-spec ones.\n (\"m.room.message\" (ement-room--format-message event room session))\n (\"m.room.member\"\n (widget-create 'ement-room-membership\n :button-face 'ement-room-membership\n :value event)\n \"\")\n (\"m.reaction\"\n ;; Handled by defevent-based handler.\n \"\")\n (\"m.room.avatar\"\n (ement-room-wrap-prefix\n (format \"%s changed the room's avatar.\"\n (propertize (ement--user-displayname-in room (ement-event-sender event))\n 'help-echo (ement-user-id (ement-event-sender event))))\n 'face 'ement-room-membership))\n (\"m.room.power_levels\"\n (ement-room--format-power-levels-event event room session))\n (\"m.room.canonical_alias\"\n (ement-room--format-canonical-alias-event event room session))\n (_ (ement-room-wrap-prefix\n (format \"[sender:%s type:%s]\"\n (ement-user-id (ement-event-sender event))\n (ement-event-type event))\n 'help-echo (format \"%S\" (ement-event-content event)))))\n (propertize \" \"\n 'display ement-room-event-separator-display-property)))\n\n(defun ement-room--format-reactions (event)\n \"Return formatted reactions to EVENT.\"\n ;; TODO: Like other events, pop to a buffer showing the raw reaction events when a key is pressed.\n (if-let ((reactions (map-elt (ement-event-local event) 'reactions)))\n (cl-labels ((format-reaction\n (ks) (pcase-let* ((`(,key . ,senders) ks)\n (key (propertize key 'face 'ement-room-reactions-key))\n (count (propertize (format \" (%s)\" (length senders))\n 'face 'ement-room-reactions))\n (string\n (propertize (concat key count)\n 'button '(t)\n 'category 'default-button\n 'action #'ement-room-reaction-button-action\n 'follow-link t\n 'help-echo (lambda (_window buffer _pos)\n ;; NOTE: If the reaction key string is a Unicode character composed\n ;; with, e.g. \"VARIATION SELECTOR-16\", `string-to-char' ignores the\n ;; composed modifier/variation-selector and just returns the first\n ;; character of the string. This should be fine, since it's just\n ;; for the tooltip.\n (concat\n (get-char-code-property (string-to-char key) 'name) \": \"\n (senders-names senders (buffer-local-value 'ement-room buffer))))))\n (local-user-p (cl-member (ement-user-id (ement-session-user ement-session)) senders\n :key #'ement-user-id :test #'equal)))\n (when local-user-p\n (add-face-text-property 0 (length string) '(:box (:style pressed-button) :inverse-video t)\n nil string))\n (ement--remove-face-property string 'button)\n string))\n (senders-names\n (senders room) (cl-loop for sender in senders\n collect (ement--user-displayname-in room sender)\n into names\n finally return (string-join names \", \"))))\n (cl-loop with keys-senders\n for reaction in reactions\n for key = (map-nested-elt (ement-event-content reaction) '(m.relates_to key))\n for sender = (ement-event-sender reaction)\n do (push sender (alist-get key keys-senders nil nil #'string=))\n finally do (setf keys-senders (cl-sort keys-senders #'> :key (lambda (pair) (length (cdr pair)))))\n finally return (concat \"\\n \" (mapconcat #'format-reaction keys-senders \" \"))))\n \"\"))\n\n(cl-defun ement-room--format-message (event room session &optional (format ement-room-message-format-spec))\n \"Return EVENT in ROOM on SESSION formatted according to FORMAT.\nFormat defaults to `ement-room-message-format-spec', which see.\"\n ;; Bind this locally so formatters can modify it for this call.\n (let ((ement-room--format-message-margin-p)\n (left-margin-width ement-room-left-margin-width)\n (right-margin-width ement-room-right-margin-width))\n ;; Copied from `format-spec'.\n (with-temp-buffer\n ;; Pretend this is a room buffer.\n (setf ement-session session\n ement-room room)\n ;; HACK: Setting these buffer-locally in a temp buffer is ugly.\n (setq-local ement-room-left-margin-width left-margin-width)\n (setq-local ement-room-right-margin-width right-margin-width)\n (insert format)\n (goto-char (point-min))\n (while (search-forward \"%\" nil t)\n (cond\n ((eq (char-after) ?%)\n ;; Quoted percent sign.\n (delete-char 1))\n ((looking-at \"\\\$[-0-9.]*\\\$\\\$[a-zA-Z]\\\$\")\n ;; Valid format spec.\n (let* ((num (match-string 1))\n (spec (string-to-char (match-string 2)))\n (_\n ;; We delete the specifier now, because the formatter may change the\n ;; match data, and we already have what we need.\n (delete-region (1- (match-beginning 0)) (match-end 0)))\n (formatter (or (alist-get spec ement-room-event-formatters)\n (error \"Invalid format character: `%%%c'\" spec)))\n (val (or (funcall formatter event room session)\n (let ((print-level 1))\n (propertize (format \"[Event has no value for spec \\\"?%s\\\"]\" (char-to-string spec))\n 'face 'font-lock-comment-face\n 'help-echo (format \"%S\" event)))))\n ;; Pad result to desired length.\n (text (format (concat \"%\" num \"s\") val)))\n (insert text)))\n (t\n ;; Signal an error on bogus format strings.\n (error \"ement-room--format-message: Invalid format string: %S\" format))))\n ;; Propertize margin text.\n (when ement-room--format-message-wrap-prefix\n (when-let ((wrap-prefix-end (next-single-property-change (point-min) 'wrap-prefix-end)))\n (let* ((prefix-width (string-width\n (buffer-substring-no-properties (point-min) wrap-prefix-end)))\n (prefix (propertize \" \" 'display `((space :width ,prefix-width)))))\n (goto-char wrap-prefix-end)\n (delete-char 1)\n ;; We apply the prefix to the entire event as `wrap-prefix', and to just the\n ;; body as `line-prefix'.\n (put-text-property (point-min) (point-max) 'wrap-prefix prefix)\n (put-text-property (point) (point-max) 'line-prefix prefix))))\n (when ement-room--format-message-margin-p\n (when-let ((left-margin-end (next-single-property-change (point-min) 'left-margin-end)))\n (goto-char left-margin-end)\n (delete-char 1)\n (let ((left-margin-text-width (string-width (buffer-substring-no-properties (point-min) (point)))))\n ;; It would be preferable to not have to allocate a string to\n ;; calculate the display width, but I don't know of another way.\n (put-text-property (point-min) (point)\n 'display `((margin left-margin)\n ,(buffer-substring (point-min) (point))))\n (save-excursion\n (goto-char (point-min))\n ;; Insert a string with a display specification that causes it to be displayed in the\n ;; left margin as a space that displays with the width of the difference between the\n ;; left margin's width and the display width of the text in the left margin (whew).\n ;; This is complicated, but it seems to work (minus a possible Emacs/Gtk bug that\n ;; sometimes causes the space to have a little \"junk\" displayed in it at times, but\n ;; that's not our fault). (And this is another example of how well-documented Emacs\n ;; is: this was only possible by carefully reading the Elisp manual.)\n (insert (propertize \" \" 'display `((margin left-margin)\n (space :width (- left-margin ,left-margin-text-width))))))))\n (when-let ((right-margin-start (next-single-property-change (point-min) 'right-margin-start)))\n (goto-char right-margin-start)\n (delete-char 1)\n (let ((string (buffer-substring (point) (point-max))))\n ;; Relocate its text to the beginning so it won't be\n ;; displayed at the last line of wrapped messages.\n (delete-region (point) (point-max))\n (goto-char (point-min))\n (insert-and-inherit\n (propertize \" \"\n 'display `((margin right-margin) ,string))))))\n (buffer-string))))\n\n(cl-defun ement-room--format-message-body (event &key (formatted-p t))\n \"Return formatted body of \\\"m.room.message\\\" EVENT.\nIf FORMATTED-P, return the formatted body content, when available.\"\n (pcase-let* (((cl-struct ement-event content\n (unsigned (map ('redacted_by unsigned-redacted-by)))\n (local (map ('redacted-by local-redacted-by))))\n event)\n ((map ('body main-body) msgtype ('format content-format) ('formatted_body formatted-body)\n ('m.relates_to (map ('rel_type rel-type)))\n ('m.new_content (map ('body new-body) ('formatted_body new-formatted-body)\n ('format new-content-format))))\n content)\n (body (or new-body main-body))\n (formatted-body (or new-formatted-body formatted-body))\n (body (if (or (not formatted-p) (not formatted-body))\n ;; Copy the string so as not to add face properties to the one in the struct.\n (copy-sequence body)\n (pcase (or new-content-format content-format)\n (\"org.matrix.custom.html\"\n (save-match-data\n (ement-room--render-html formatted-body)))\n (_ (format \"[unknown body format: %s] %s\"\n (or new-content-format content-format) body)))))\n (appendix (pcase msgtype\n ;; TODO: Face for m.notices.\n ((or \"m.text\" \"m.emote\" \"m.notice\") nil)\n (\"m.image\" (ement-room--format-m.image event))\n (\"m.file\" (ement-room--format-m.file event))\n (\"m.video\" (ement-room--format-m.video event))\n (_ (if (or local-redacted-by unsigned-redacted-by)\n nil\n (format \"[unsupported msgtype: %s]\" msgtype ))))))\n (when body\n ;; HACK: Once I got an error when body was nil, so let's avoid that.\n (setf body (ement-room--linkify-urls body)))\n ;; HACK: Ensure body isn't nil (e.g. redacted messages can have empty bodies).\n (unless body\n (setf body (copy-sequence\n ;; Yes, copying this string is necessary here too, otherwise a single\n ;; string will be used across every call to this function, whose face\n ;; properties will be added to every time in other functions, which will\n ;; make a very big mess of face properties if a room's buffer is opened\n ;; and closed a few times.\n (if (or local-redacted-by unsigned-redacted-by)\n \"[redacted]\"\n \"[message has no body content]\"))))\n (when appendix\n (setf body (concat body \" \" appendix)))\n (when (equal \"m.replace\" rel-type)\n ;; Message is an edit.\n (setf body (concat body \" \" (propertize \"[edited]\" 'face 'font-lock-comment-face))))\n body))\n\n(defun ement-room--render-html (string)\n \"Return rendered version of HTML STRING.\nHTML is rendered to Emacs text using `shr-insert-document'.\"\n (with-temp-buffer\n (insert string)\n (save-excursion\n ;; NOTE: We workaround `shr`'s not indenting the blockquote properly (it\n ;; doesn't seem to compensate for the margin). I don't know exactly how\n ;; `shr-tag-blockquote' and `shr-mark-fill' and `shr-fill-line' and\n ;; `shr-indentation' work together, but through trial-and-error, this\n ;; seems to work. It even seems to work properly when a window is\n ;; resized (i.e. the wrapping is adjusted automatically by redisplay\n ;; rather than requiring the message to be re-rendered to HTML).\n (let ((shr-use-fonts ement-room-shr-use-fonts)\n (old-fn (symbol-function 'shr-tag-blockquote))) ;; Bind to a var to avoid unknown-function linting errors.\n (cl-letf (((symbol-function 'shr-fill-line) #'ignore)\n ((symbol-function 'shr-tag-blockquote)\n (lambda (dom)\n (let ((beg (point-marker)))\n (funcall old-fn dom)\n (add-text-properties beg (point-max)\n '(wrap-prefix \" \"\n line-prefix \" \"))))))\n (shr-insert-document\n (libxml-parse-html-region (point-min) (point-max))))))\n (string-trim (buffer-substring (point) (point-max)))))\n\n(cl-defun ement-room--event-mentions-user-p (event user &optional (room ement-room))\n \"Return non-nil if EVENT in ROOM mentions USER.\"\n (pcase-let* (((cl-struct ement-event content) event)\n ((map body formatted_body) content)\n (body (or formatted_body body)))\n ;; FIXME: `ement--user-displayname-in' may not be returning the right result for the\n ;; local user, so test the displayname slot too. (But even that may be nil sometimes?\n ;; Something needs to be fixed...)\n ;; HACK: So we use the username slot, which was created just for this, for now.\n (when body\n (cl-macrolet ((matches-body-p\n (form) `(when-let ((string ,form))\n (string-match-p (regexp-quote string) body))))\n (or (matches-body-p (ement-user-username user))\n (matches-body-p (ement--user-displayname-in room user))\n (matches-body-p (ement-user-id user)))))))\n\n(defun ement-room--linkify-urls (string)\n \"Return STRING with URLs in it made clickable.\"\n ;; Is there an existing Emacs function to do this? I couldn't find one.\n ;; Yes, maybe: `goto-address-mode'. TODO: Try goto-address-mode.\n (with-temp-buffer\n (insert string)\n (goto-char (point-min))\n (cl-loop while (re-search-forward (rx bow \"http\" (optional \"s\") \"://\" (1+ (not space)))\n nil 'noerror)\n do (make-text-button (match-beginning 0) (match-end 0)\n 'mouse-face 'highlight\n 'face 'link\n 'help-echo (match-string 0)\n 'action #'browse-url-at-mouse\n 'follow-link t))\n (buffer-string)))\n\n;; NOTE: This function is not useful when displaynames are shown in the margin, because\n;; margins are not mouse-interactive in Emacs, therefore the help-echo function is called\n;; with the string and the position in the string, which leaves the buffer position\n;; unknown. So we have to set the help-echo to a string rather than a function. But the\n;; function may be useful in the future, so leaving it commented for now.\n\n;; (defun ement-room--user-help-echo (window _object pos)\n;; \"Return user ID string for POS in WINDOW.\n;; For use as a `help-echo' function on `ement-user' headings.\"\n;; (let ((data (with-selected-window window\n;; (ewoc-data (ewoc-locate ement-ewoc pos)))))\n;; (cl-typecase data\n;; (ement-event (ement-user-id (ement-event-sender data)))\n;; (ement-user (ement-user-id data)))))\n\n(defun ement-room--user-color (user)\n \"Return a color in which to display USER's messages.\"\n (cl-labels ((relative-luminance\n ;; Copy of `modus-themes-wcag-formula', an elegant\n ;; implementation by Protesilaos Stavrou. Also see\n ;; and\n ;; .\n (rgb) (cl-loop for k in '(0.2126 0.7152 0.0722)\n for x in rgb\n sum (* k (if (<= x 0.03928)\n (/ x 12.92)\n (expt (/ (+ x 0.055) 1.055) 2.4)))))\n (contrast-ratio\n ;; Copy of `modus-themes-contrast'; see above.\n (a b) (let ((ct (/ (+ (relative-luminance a) 0.05)\n (+ (relative-luminance b) 0.05))))\n (max ct (/ ct))))\n (increase-contrast\n (color against target toward)\n (let ((gradient (cdr (color-gradient color toward 20)))\n new-color)\n (cl-loop do (setf new-color (pop gradient))\n while new-color\n until (>= (contrast-ratio new-color against) target)\n ;; Avoid infinite loop in case of weirdness\n ;; by returning color as a fallback.\n finally return (or new-color color)))))\n (let* ((id (ement-user-id user))\n (id-hash (float (+ (abs (sxhash id)) ement-room-prism-color-adjustment)))\n ;; TODO: Wrap-around the value to get the color I want.\n (ratio (/ id-hash (float most-positive-fixnum)))\n (color-num (round (* (* 255 255 255) ratio)))\n (color-rgb (list (/ (float (logand color-num 255)) 255)\n (/ (float (lsh (logand color-num 65280) -8)) 255)\n (/ (float (lsh (logand color-num 16711680) -16)) 255)))\n (background-rgb (color-name-to-rgb (face-background 'default))))\n (when (< (contrast-ratio color-rgb background-rgb) ement-room-prism-minimum-contrast)\n (setf color-rgb (increase-contrast color-rgb background-rgb ement-room-prism-minimum-contrast\n (color-name-to-rgb (face-foreground 'default)))))\n (apply #'color-rgb-to-hex (append color-rgb (list 2))))))\n\n;;;;; Compose buffer\n\n;; Compose messages in a separate buffer, like `org-edit-special'.\n\n(defvar-local ement-room-compose-buffer nil\n \"Non-nil in buffers that are composing a message to a room.\")\n\n(cl-defun ement-room-compose-message (room session &key body)\n \"Compose a message to ROOM on SESSION.\nInteractively, with prefix, prompt for room and session,\notherwise use current room. With BODY, use it as the initial\nmessage contents.\"\n (interactive\n (ement-with-room-and-session\n (list ement-room ement-session)))\n (let* ((compose-buffer (generate-new-buffer (format \"*Ement compose: %s*\" (ement--room-display-name ement-room))))\n (send-message-filter ement-room-send-message-filter))\n (with-current-buffer compose-buffer\n (ement-room-init-compose-buffer room session)\n (setf ement-room-send-message-filter send-message-filter)\n ;; TODO: Make mode configurable.\n (when body\n (insert body))\n\n ;; FIXME: Inexplicably, this doesn't do anything, so we comment it out for now.\n ;; (add-function :override (local 'org-mode)\n ;; ;; HACK: Since `org-mode' kills buffer-local variables we need, we add\n ;; ;; buffer-local advice to prevent that from happening in case a user enables it.\n ;; (lambda (&rest _ignore)\n ;; (message \"Use `ement-room-compose-org' to activate Org in this buffer\")))\n\n ;; NOTE: Surprisingly, we don't run this hook in `ement-room-init-compose-buffer',\n ;; because if a function in that hook calls the init function (like\n ;; `ement-room-compose-org' does), it makes `run-hooks' recursive. As long as this\n ;; is the only function that makes the compose buffer, and as long as none of the\n ;; hooks do anything that activating `org-mode' nullifies, this should be okay...\n (run-hooks 'ement-room-compose-hook))\n (pop-to-buffer compose-buffer)))\n\n(defun ement-room-compose-from-minibuffer ()\n \"Edit the current message in a compose buffer.\nTo be called from a minibuffer opened from\n`ement-room-read-string'.\"\n (interactive)\n (cl-assert (minibufferp)) (cl-assert ement-room) (cl-assert ement-session)\n ;; TODO: When requiring Emacs 27, use `letrec'.\n ;; HACK: I can't seem to find a better way to do this, to exit the minibuffer without exiting this command too.\n (let* ((body (minibuffer-contents))\n (compose-fn-symbol (gensym (format \"ement-compose-%s\" (or (ement-room-canonical-alias ement-room)\n (ement-room-id ement-room)))))\n (input-method current-input-method) ; Capture this value from the minibuffer.\n (send-message-filter ement-room-send-message-filter)\n (replying-to-event ement-room-replying-to-event)\n (compose-fn (lambda ()\n ;; HACK: Since exiting the minibuffer restores the previous window configuration,\n ;; we have to do some magic to get the new compose buffer to appear.\n ;; TODO: Use letrec with Emacs 27.\n (remove-hook 'minibuffer-exit-hook compose-fn-symbol)\n ;; FIXME: Probably need to unintern the symbol.\n (ement-room-compose-message ement-room ement-session :body body)\n\t\t ;; FIXME: This doesn't propagate the send-message-filter to the minibuffer.\n (setf ement-room-send-message-filter send-message-filter)\n (setq-local ement-room-replying-to-event replying-to-event)\n (when replying-to-event\n (setq-local header-line-format\n (concat header-line-format\n (format \" (Replying to message from %s)\"\n (ement--user-displayname-in\n ement-room (ement-event-sender replying-to-event))))))\n (let* ((compose-buffer (current-buffer))\n (show-buffer-fn-symbol (gensym \"ement-show-compose-buffer\"))\n (show-buffer-fn (lambda ()\n (remove-hook 'window-configuration-change-hook show-buffer-fn-symbol)\n ;; FIXME: Probably need to unintern the symbol.\n (pop-to-buffer compose-buffer)\n (set-input-method input-method))))\n (fset show-buffer-fn-symbol show-buffer-fn)\n (add-hook 'window-configuration-change-hook show-buffer-fn-symbol)))))\n (fset compose-fn-symbol compose-fn)\n (add-hook 'minibuffer-exit-hook compose-fn-symbol)\n ;; Deactivate minibuffer's input method, otherwise subsequent\n ;; minibuffers will have it, too.\n (deactivate-input-method)\n (abort-recursive-edit)))\n\n(defun ement-room-compose-send ()\n \"Prompt to send the current compose buffer's contents.\nTo be called from an `ement-room-compose' buffer.\"\n (interactive)\n (cl-assert ement-room-compose-buffer)\n (cl-assert ement-room) (cl-assert ement-session)\n ;; Putting it in the kill ring seems like the best thing to do, to ensure\n ;; it doesn't get lost if the user exits the minibuffer before sending.\n (kill-new (string-trim (buffer-string)))\n (let ((room ement-room)\n (session ement-session)\n (input-method current-input-method)\n (send-message-filter ement-room-send-message-filter)\n (replying-to-event ement-room-replying-to-event))\n (quit-restore-window nil 'kill)\n (ement-view-room room session)\n (let* ((prompt (format \"Send message (%s): \" (ement-room-display-name ement-room)))\n (current-input-method input-method) ; Bind around read-string call.\n (ement-room-send-message-filter send-message-filter)\n (pos (when replying-to-event\n (ewoc-location (ement-room--ewoc-last-matching ement-ewoc\n (lambda (data)\n (eq data replying-to-event))))))\n (body (if replying-to-event\n (ement-room-with-highlighted-event-at pos\n (ement-room-read-string prompt (car kill-ring) nil nil 'inherit-input-method))\n (ement-room-read-string prompt (car kill-ring) nil nil 'inherit-input-method)) ))\n (ement-room-send-message ement-room ement-session :body body :replying-to-event replying-to-event))))\n\n(defun ement-room-init-compose-buffer (room session)\n \"Eval BODY, setting up the current buffer as a compose buffer.\nSets ROOM and SESSION buffer-locally, binds `save-buffer' in\na copy of the local keymap, and sets `header-line-format'.\"\n ;; Using a macro for this seems awkward but necessary.\n (setq-local ement-room room)\n (setq-local ement-session session)\n (setf ement-room-compose-buffer t)\n (setq-local completion-at-point-functions\n (append '(ement-room--complete-members-at-point ement-room--complete-rooms-at-point)\n completion-at-point-functions))\n ;; FIXME: Compose with local map?\n (use-local-map (if (current-local-map)\n (copy-keymap (current-local-map))\n (make-sparse-keymap)))\n (local-set-key [remap save-buffer] #'ement-room-compose-send)\n (setq header-line-format (substitute-command-keys\n (format \" Press \\\\[save-buffer] to send message to room (%s)\"\n (ement-room-display-name room)))))\n\n;;;;; Widgets\n\n(require 'widget)\n\n(define-widget 'ement-room-membership 'item\n \"Widget for membership events.\"\n ;; FIXME: This makes it hard to add a timestamp according to the buffer's message format spec.\n\n ;; FIXME: The widget value inserts an extra space before the wrap prefix. There seems\n ;; to be no way to fix this while still using a widget for this, so maybe we shouldn't\n ;; use a widget after all. But it might be good to keep digging for a solution so that\n ;; widgets could be used for other things later...\n :format \"%{ %v %}\"\n :sample-face 'ement-room-membership\n :value-create (lambda (widget)\n (pcase-let* ((event (widget-value widget)))\n (insert (ement-room-wrap-prefix\n (ement-room--format-member-event event ement-room))))))\n\n(defun ement-room--format-member-event (event room)\n \"Return formatted string for \\\"m.room.member\\\" EVENT in ROOM.\"\n ;; SPEC: Section 9.3.4: \"m.room.member\".\n (pcase-let* (((cl-struct ement-event sender state-key\n (content (map reason ('avatar_url new-avatar-url)\n ('membership new-membership) ('displayname new-displayname)))\n (unsigned (map ('prev_content (map ('avatar_url old-avatar-url)\n ('membership prev-membership)\n ('displayname prev-displayname))))))\n event)\n (sender-name (ement--user-displayname-in ement-room sender)))\n (cl-macrolet ((nes (var)\n ;; For \"non-empty-string\". Needed because the displayname can be\n ;; an empty string, but apparently is never null. (Note that the\n ;; argument should be a variable, never any other form, to avoid\n ;; multiple evaluation.)\n `(when (and ,var (not (string-empty-p ,var)))\n ,var))\n (sender-name-id-string\n () `(propertize sender-name\n 'help-echo (ement-user-id sender)))\n (new-displayname-sender-name-state-key-string\n () `(propertize (or (nes new-displayname) (nes sender-name) (nes state-key))\n 'help-echo state-key))\n (sender-name-state-key-string\n () `(propertize sender-name\n 'help-echo state-key))\n (prev-displayname-id-string\n () `(propertize (or prev-displayname sender-name)\n 'help-echo (ement-user-id sender))))\n (pcase-exhaustive new-membership\n (\"invite\"\n (pcase prev-membership\n ((or \"leave\" '())\n (format \"%s invited %s\"\n (sender-name-id-string)\n (new-displayname-sender-name-state-key-string)))\n (_ (format \"%s sent unrecognized invite event for %s\"\n (sender-name-id-string)\n (new-displayname-sender-name-state-key-string)))))\n (\"join\"\n (pcase prev-membership\n (\"invite\"\n (format \"%s accepted invitation to join\"\n (sender-name-state-key-string)))\n (\"join\"\n (cond ((not (equal new-displayname prev-displayname))\n (propertize (format \"%s changed name to %s\"\n prev-displayname (or new-displayname (ement--user-displayname-in room sender)))\n 'help-echo state-key))\n ((not (equal new-avatar-url old-avatar-url))\n (format \"%s changed avatar\"\n (new-displayname-sender-name-state-key-string)))\n (t (format \"Unrecognized membership event for %s\"\n (sender-name-state-key-string)))))\n (\"leave\"\n (format \"%s rejoined\"\n (sender-name-state-key-string)))\n (`nil\n (format \"%s joined\"\n (new-displayname-sender-name-state-key-string)))\n (_ (format \"%s sent unrecognized join event for %s\"\n (sender-name-id-string)\n (new-displayname-sender-name-state-key-string)))))\n (\"leave\"\n (pcase prev-membership\n (\"invite\"\n (pcase state-key\n ((pred (equal (ement-user-id sender)))\n (format \"%s rejected invitation\"\n (sender-name-id-string)))\n (_ (format \"%s revoked %s's invitation\"\n (sender-name-id-string)\n (new-displayname-sender-name-state-key-string)))))\n (\"join\"\n (pcase state-key\n ((pred (equal (ement-user-id sender)))\n (format \"%s left%s\"\n (prev-displayname-id-string)\n (if reason\n (format \" (%s)\" reason)\n \"\")))\n (_ (format \"%s kicked %s%s\"\n (sender-name-id-string)\n (propertize (or prev-displayname state-key)\n 'help-echo state-key)\n (if reason\n (format \" (%s)\" reason)\n \"\")))))\n (\"ban\"\n (format \"%s unbanned %s\"\n (sender-name-id-string)\n state-key))\n (_ (format \"%s left%s\"\n (prev-displayname-id-string)\n (if reason\n (format \" (%s)\" reason)\n \"\")))))\n (\"ban\"\n (pcase prev-membership\n ((or \"invite\" \"leave\")\n (format \"%s banned %s%s\"\n (sender-name-id-string)\n (propertize (or prev-displayname state-key)\n 'help-echo state-key)\n (if reason\n (format \" (%s)\" reason)\n \"\")))\n (\"join\"\n (format \"%s kicked and banned %s%s\"\n (sender-name-id-string)\n (propertize (or prev-displayname state-key)\n 'help-echo state-key)\n (if reason\n (format \" (%s)\" reason)\n \"\")))\n (_ (format \"%s sent unrecognized ban event for %s\"\n (sender-name-id-string)\n (propertize (or prev-displayname state-key)\n 'help-echo state-key)))))))))\n\n;; NOTE: Widgets are only currently used for single membership events, not grouped ones.\n\n(defun ement-room--format-membership-events (struct room)\n \"Return string for STRUCT in ROOM.\nSTRUCT should be an `ement-room-membership-events' struct.\"\n (cl-labels ((event-user\n (event) (propertize (if-let (user (gethash (ement-event-state-key event) ement-users))\n (ement--user-displayname-in room user)\n (ement-event-state-key event))\n 'help-echo (concat (ement-room--format-member-event event room)\n \" <\" (ement-event-state-key event) \">\")))\n (old-membership (event) (map-nested-elt (ement-event-unsigned event) '(prev_content membership)))\n (new-membership (event) (alist-get 'membership (ement-event-content event))))\n (pcase-let* (((cl-struct ement-room-membership-events events) struct))\n (pcase (length events)\n (0 (warn \"No events in `ement-room-membership-events' struct\"))\n (1 (ement-room--format-member-event (car events) room))\n (_ (let* ((left-events (cl-remove-if-not (lambda (event)\n (and (equal \"leave\" (new-membership event))\n (not (member (old-membership event) '(\"ban\" \"invite\")))))\n events))\n (join-events (cl-remove-if-not (lambda (event)\n (and (equal \"join\" (new-membership event))\n (not (equal \"join\" (old-membership event)))))\n events))\n (rejoin-events (cl-remove-if-not (lambda (event)\n (and (equal \"join\" (new-membership event))\n (equal \"leave\" (old-membership event))))\n events))\n (invite-events (cl-remove-if-not (lambda (event)\n (equal \"invite\" (new-membership event)))\n events))\n (reject-events (cl-remove-if-not (lambda (event)\n (and (equal \"invite\" (old-membership event))\n (equal \"leave\" (new-membership event))))\n events))\n (ban-events (cl-remove-if-not (lambda (event)\n (and (member (old-membership event) '(\"invite\" \"leave\"))\n (equal \"ban\" (new-membership event))))\n events))\n (unban-events (cl-remove-if-not (lambda (event)\n (and (equal \"ban\" (old-membership event))\n (equal \"leave\" (new-membership event))))\n events))\n (kick-and-ban-events (cl-remove-if-not (lambda (event)\n (and (equal \"join\" (old-membership event))\n (equal \"ban\" (new-membership event))))\n events))\n (rename-events (cl-remove-if-not (lambda (event)\n (and (equal \"join\" (old-membership event))\n (equal \"join\" (new-membership event))\n (equal (alist-get 'avatar_url (ement-event-content event))\n (map-nested-elt (ement-event-unsigned event)\n '(prev_content avatar_url)))))\n events))\n (avatar-events (cl-remove-if-not (lambda (event)\n (and (equal \"join\" (old-membership event))\n (equal \"join\" (new-membership event))\n (not (equal (alist-get 'avatar_url (ement-event-content event))\n (map-nested-elt (ement-event-unsigned event)\n '(prev_content avatar_url))))))\n events))\n join-and-leave-events rejoin-and-leave-events)\n ;; Remove apparent duplicates between join/rejoin events.\n (setf join-events (cl-delete-if (lambda (event)\n (cl-find (ement-event-state-key event) rejoin-events\n :test #'equal :key #'ement-event-state-key))\n join-events)\n rejoin-events (cl-delete-if (lambda (event)\n (cl-find (ement-event-state-key event) join-events\n :test #'equal :key #'ement-event-state-key))\n rejoin-events)\n join-and-leave-events (cl-loop for join-event in join-events\n for left-event = (cl-find (ement-event-state-key join-event) left-events\n :test #'equal :key #'ement-event-state-key)\n when left-event\n collect left-event\n and do (setf join-events (cl-delete (ement-event-state-key join-event) join-events\n :test #'equal :key #'ement-event-state-key)\n left-events (cl-delete (ement-event-state-key left-event) left-events\n :test #'equal :key #'ement-event-state-key)))\n rejoin-and-leave-events (cl-loop for rejoin-event in rejoin-events\n for left-event = (cl-find (ement-event-state-key rejoin-event) left-events\n :test #'equal :key #'ement-event-state-key)\n when left-event\n collect left-event\n and do (setf rejoin-events (cl-delete\n (ement-event-state-key rejoin-event) rejoin-events\n :test #'equal :key #'ement-event-state-key)\n left-events (cl-delete (ement-event-state-key left-event) left-events\n :test #'equal :key #'ement-event-state-key))))\n (format \"Membership: %s.\"\n (string-join (cl-loop for (type . events)\n in (ement-alist \"rejoined\" rejoin-events\n \"joined\" join-events\n \"left\" left-events\n \"joined and left\" join-and-leave-events\n \"rejoined and left\" rejoin-and-leave-events\n \"invited\" invite-events\n \"rejected invitation\" reject-events\n \"banned\" ban-events\n \"unbanned\" unban-events\n \"kicked and banned\" kick-and-ban-events\n \"changed name\" rename-events\n \"changed avatar\" avatar-events)\n for users = (mapcar #'event-user\n (cl-delete-duplicates\n events :key #'ement-event-state-key))\n for number = (length users)\n when events\n collect (format \"%s %s (%s)\" number\n (propertize type 'face 'bold)\n (string-join users \", \")))\n \"; \"))))))))\n\n;;;;; Images\n\n;; Downloading and displaying images in messages, room/user avatars, etc.\n\n(require 'image)\n\n(defvar ement-room-image-keymap\n (let ((map (make-sparse-keymap)))\n (set-keymap-parent map image-map)\n ;; TODO: Make RET work for showing images too.\n ;; (define-key map (kbd \"RET\") #'ement-room-image-show)\n (define-key map [mouse-1] #'ement-room-image-scale-mouse)\n (define-key map [double-mouse-1] #'ement-room-image-show)\n map)\n \"Keymap for images in room buffers.\")\n\n(defgroup ement-room-images nil\n \"Showing images in rooms.\"\n :group 'ement-room)\n\n(defcustom ement-room-images t\n \"Download and show images in messages, avatars, etc.\"\n :type 'boolean\n :set (lambda (option value)\n (if (or (fboundp 'imagemagick-types)\n (when (fboundp 'image-transforms-p)\n (image-transforms-p)))\n (set-default option value)\n (set-default option nil)\n (when (and value (display-images-p))\n (display-warning 'ement \"This Emacs was not built with ImageMagick support, nor does it support Cairo/XRender scaling, so images can't be displayed in Ement\")))))\n\n(defcustom ement-room-image-initial-height 0.2\n \"Limit images' initial display height.\nIf a number, it should be no larger than 1 (because Emacs can't\ndisplay images larger than the window body height).\"\n :type '(choice (const :tag \"Use full window width\" nil)\n (number :tag \"Limit to this multiple of the window body height\")))\n\n(defun ement-room-image-scale-mouse (event)\n \"Toggle scale of image at mouse EVENT.\nScale image to fit within the window's body. If image is already\nfit to the window, reduce its max-height to 10% of the window's\nheight.\"\n (interactive \"e\")\n (pcase-let* ((`(,_type ,position ,_count) event)\n (window (posn-window position))\n (pos (event-start position)))\n (with-selected-window window\n (pcase-let* ((image (get-text-property pos 'display))\n (window-width (window-body-width nil t))\n (window-height (window-body-height nil t))\n ;; Image scaling commands set :max-height and friends to nil so use the\n ;; impossible dummy value -1. See .\n (new-height (if (= window-height (or (image-property image :max-height) -1))\n (/ window-height 10)\n window-height)))\n (when (fboundp 'imagemagick-types)\n ;; Only do this when ImageMagick is supported.\n ;; FIXME: When requiring Emacs 27+, remove this (I guess?).\n (setf (image-property image :type) 'imagemagick))\n ;; Set :scale to nil since image scaling commands might have changed it.\n (setf (image-property image :scale) nil\n (image-property image :max-width) window-width\n (image-property image :max-height) new-height)))))\n\n(defun ement-room-image-show (event)\n \"Show image at mouse EVENT in a new buffer.\"\n (interactive \"e\")\n (pcase-let* ((`(,_type ,position ,_count) event)\n (window (posn-window position)))\n (with-current-buffer (window-buffer window)\n (pcase-let* ((pos (event-start position))\n (image (copy-sequence (get-text-property pos 'display)))\n (ement-event (ewoc-data (ewoc-locate ement-ewoc pos)))\n ((cl-struct ement-event id) ement-event)\n (buffer-name (format \"*Ement image: %s*\" id))\n (new-buffer (get-buffer-create buffer-name)))\n (when (fboundp 'imagemagick-types)\n ;; Only do this when ImageMagick is supported.\n ;; FIXME: When requiring Emacs 27+, remove this (I guess?).\n (setf (image-property image :type) 'imagemagick))\n (setf (image-property image :scale) 1.0\n (image-property image :max-width) nil\n (image-property image :max-height) nil)\n (with-current-buffer new-buffer\n (erase-buffer)\n (insert-image image))\n (pop-to-buffer new-buffer '((display-buffer-pop-up-frame)))\n (set-frame-parameter nil 'fullscreen 'maximized)))))\n\n(defun ement-room--format-m.image (event)\n \"Return \\\"m.image\\\" EVENT formatted as a string.\nWhen `ement-room-images' is non-nil, also download it and then\nshow it in the buffer.\"\n (pcase-let* (((cl-struct ement-event content (local event-local)) event)\n ;; HACK: Get the room's buffer from the variable (the current buffer\n ;; will be a temp formatting buffer when this is called, but it still\n ;; inherits the `ement-room' variable from the room buffer, thankfully).\n ((cl-struct ement-room local) ement-room)\n ((map buffer) local)\n ;; TODO: Thumbnail support.\n ((map ('url mxc) info ;; ('thumbnail_url thumbnail-url)\n ) content)\n ((map thumbnail_info) info)\n ((map ('h _thumbnail-height) ('w _thumbnail-width)) thumbnail_info)\n ((map image) event-local)\n (url (when mxc\n (ement--mxc-to-url mxc ement-session)))\n ;; (thumbnail-url (ement--mxc-to-url thumbnail-url ement-session))\n )\n (if (and ement-room-images image)\n ;; Images enabled and image downloaded: create image and\n ;; return it in a string.\n (condition-case err\n (let ((image (create-image image nil 'data-p :ascent 'center))\n (buffer-window (when buffer\n (get-buffer-window buffer)))\n max-height max-width)\n ;; Calculate max image display size.\n (cond (ement-room-image-initial-height\n ;; Use configured value.\n (setf max-height (truncate\n ;; Emacs doesn't like floats as the max-height.\n (* (window-body-height buffer-window t)\n ement-room-image-initial-height))\n max-width (window-body-width buffer-window t)))\n (buffer-window\n ;; Buffer displayed: use window size.\n (setf max-height (window-body-height buffer-window t)\n max-width (window-body-width buffer-window t)))\n (t\n ;; Buffer not displayed: use frame size.\n (setf max-height (frame-pixel-height)\n max-width (frame-pixel-width))))\n (when (fboundp 'imagemagick-types)\n ;; Only do this when ImageMagick is supported.\n ;; FIXME: When requiring Emacs 27+, remove this (I guess?).\n (setf (image-property image :type) 'imagemagick))\n (setf (image-property image :max-width) max-width\n (image-property image :max-height) max-height\n (image-property image :relief) 2\n (image-property image :margin) 5\n (image-property image :pointer) 'hand)\n (concat \"\\n\"\n (ement-room-wrap-prefix \" \"\n 'display image\n 'keymap ement-room-image-keymap)))\n (error (format \"\\n [error inserting image: %s]\" (error-message-string err))))\n ;; Image not downloaded: insert URL as button, and download if enabled.\n (prog1\n (ement-room-wrap-prefix \"[image]\"\n 'action #'browse-url\n 'button t\n 'button-data url\n 'category t\n 'face 'button\n 'follow-link t\n 'help-echo url\n 'keymap button-map\n 'mouse-face 'highlight)\n (when (and ement-room-images url)\n ;; Images enabled and URL present: download it.\n (plz-run\n (plz-queue ement-images-queue\n 'get url :as 'binary\n :then (apply-partially #'ement-room--m.image-callback event ement-room)\n :noquery t)))))))\n\n(defun ement-room--m.image-callback (event room data)\n \"Add downloaded image from DATA to EVENT in ROOM.\nThen invalidate EVENT's node to show the image.\"\n (pcase-let* (((cl-struct ement-room (local (map buffer))) room))\n (setf (map-elt (ement-event-local event) 'image) data)\n (when (buffer-live-p buffer)\n (with-current-buffer buffer\n (if-let (node (ement-room--ewoc-last-matching ement-ewoc\n (lambda (node-data)\n (eq node-data event))))\n (ewoc-invalidate ement-ewoc node)\n ;; This shouldn't happen, but very rarely, it can. I haven't figured out why\n ;; yet, so checking whether a node is found rather than blindly calling\n ;; `ewoc-invalidate' prevents an error from aborting event processing.\n (display-warning 'ement-room--m.image-callback\n (format \"Event %S not found in room %S (a very rare, as-yet unexplained bug, which can be safely ignored; you may disconnect and reconnect if you wish, but it isn't strictly necessary)\"\n (ement-event-id event)\n (ement-room-display-name room))))))))\n\n(defun ement-room--format-m.file (event)\n \"Return \\\"m.file\\\" EVENT formatted as a string.\"\n ;; TODO: Insert thumbnail images when enabled.\n (pcase-let* (((cl-struct ement-event\n (content (map filename\n ('info (map mimetype size))\n ('url mxc-url))))\n event)\n (url (when mxc-url\n (ement--mxc-to-url mxc-url ement-session)))\n (human-size (file-size-human-readable size))\n (string (format \"[file: %s (%s) (%s)]\" filename mimetype human-size)))\n (concat (propertize string\n 'action #'browse-url\n 'button t\n 'button-data url\n 'category t\n 'face 'button\n 'follow-link t\n 'help-echo url\n 'keymap button-map\n 'mouse-face 'highlight)\n (propertize \" \"\n 'display '(space :relative-height 1.5)))))\n\n(defun ement-room--format-m.video (event)\n \"Return \\\"m.video\\\" EVENT formatted as a string.\"\n ;; TODO: Insert thumbnail images when enabled.\n (pcase-let* (((cl-struct ement-event\n (content (map body\n ('info (map mimetype size w h))\n ('url mxc-url))))\n event)\n (url (when mxc-url\n (ement--mxc-to-url mxc-url ement-session)))\n (human-size (file-size-human-readable size))\n (string (format \"[video: %s (%s) (%sx%s) (%s)]\" body mimetype w h human-size)))\n (concat (propertize string\n 'action #'browse-url\n 'button t\n 'button-data url\n 'category t\n 'face 'button\n 'follow-link t\n 'help-echo url\n 'keymap button-map\n 'mouse-face 'highlight)\n (propertize \" \"\n 'display '(space :relative-height 1.5)))))\n\n;;;;; Org format sending\n\n;; Some of these declarations may need updating as Org changes.\n\n(defvar org-export-with-toc)\n(defvar org-export-with-broken-links)\n(defvar org-export-with-section-numbers)\n(defvar org-html-inline-images)\n\n(declare-function org-element-property \"org-element\")\n(declare-function org-export-data \"ox\")\n(declare-function org-export-get-caption \"ox\")\n(declare-function org-export-get-ordinal \"ox\")\n(declare-function org-export-get-reference \"ox\")\n(declare-function org-export-read-attribute \"ox\")\n(declare-function org-html--has-caption-p \"ox-html\")\n(declare-function org-html--textarea-block \"ox-html\")\n(declare-function org-html--translate \"ox-html\")\n(declare-function org-html-export-as-html \"ox-html\")\n(declare-function org-html-format-code \"ox-html\")\n\n(defun ement-room-compose-org ()\n \"Activate `org-mode' in current compose buffer.\nConfigures the buffer appropriately so that saving it will export\nthe Org buffer's contents.\"\n (interactive)\n (unless ement-room-compose-buffer\n (user-error \"This command should be run in a compose buffer. Use `ement-room-compose-message' first\"))\n ;; Calling `org-mode' seems to wipe out local variables.\n (let ((room ement-room)\n (session ement-session))\n (org-mode)\n (ement-room-init-compose-buffer room session))\n (setq-local ement-room-send-message-filter #'ement-room-send-org-filter))\n\n(defun ement-room-send-org-filter (content room)\n \"Return event CONTENT for ROOM having processed its Org content.\nThe CONTENT's body is exported with\n`org-html-export-as-html' (with some adjustments for\ncompatibility), and the result is added to the CONTENT as\n\\\"formatted_body\\\".\"\n (require 'ox-html)\n ;; The CONTENT alist has string keys before being sent.\n (pcase-let* ((body (alist-get \"body\" content nil nil #'equal))\n (formatted-body\n (save-window-excursion\n (with-temp-buffer\n (insert (ement--format-body-mentions body room\n :template \"[[https://matrix.to/#/%s][%s]]\"))\n (cl-letf (((symbol-function 'org-html-src-block)\n (symbol-function 'ement-room--org-html-src-block)))\n (let ((org-export-with-toc nil)\n (org-export-with-broken-links t)\n (org-export-with-section-numbers nil)\n (org-html-inline-images nil))\n (org-html-export-as-html nil nil nil 'body-only)))\n (with-current-buffer \"*Org HTML Export*\"\n (prog1 (string-trim (buffer-string))\n (kill-buffer)))))))\n (setf (alist-get \"formatted_body\" content nil nil #'equal) formatted-body\n (alist-get \"format\" content nil nil #'equal) \"org.matrix.custom.html\")\n content))\n\n(defun ement-room--org-html-src-block (src-block _contents info)\n \"Transcode a SRC-BLOCK element from Org to HTML.\nCONTENTS holds the contents of the item. INFO is a plist holding\ncontextual information.\n\nThis is a copy of `org-html-src-block' that uses Riot\nWeb-compatible HTML output, using HTML like:\n\n

...\"\n  (if (org-export-read-attribute :attr_html src-block :textarea)\n      (org-html--textarea-block src-block)\n    (let ((lang (pcase (org-element-property :language src-block)\n                  ;; Riot's syntax coloring doesn't support \"elisp\", but \"lisp\" works.\n                  (\"elisp\" \"lisp\")\n                  (else else)))\n\t  (code (org-html-format-code src-block info))\n\t  (label (let ((lbl (and (org-element-property :name src-block)\n\t\t\t\t (org-export-get-reference src-block info))))\n\t\t   (if lbl (format \" id=\\\"%s\\\"\" lbl) \"\"))))\n      (if (not lang) (format \"\\n%s
\" label code)\n\t(format \"\\n%s%s\\n
\"\n\t\t;; Build caption.\n\t\t(let ((caption (org-export-get-caption src-block)))\n\t\t  (if (not caption) \"\"\n\t\t    (let ((listing-number\n\t\t\t   (format\n\t\t\t    \"%s \"\n\t\t\t    (format\n\t\t\t     (org-html--translate \"Listing %d:\" info)\n\t\t\t     (org-export-get-ordinal\n\t\t\t      src-block info nil #'org-html--has-caption-p)))))\n\t\t      (format \"%s%s\"\n\t\t\t      listing-number\n\t\t\t      (string-trim (org-export-data caption info))))))\n\t\t;; Contents.\n\t\t(format \"%s
\"\n\t\t\tlang label code))))))\n\n;;;;; Completion\n\n;; Completing member and room names.\n\n(defun ement-room--complete-members-at-point ()\n  \"Complete member names and IDs at point.\nUses members in the current buffer's room.  For use in\n`completion-at-point-functions'.\"\n  (let ((beg (save-excursion\n               (when (re-search-backward (rx (or bol bos blank)) nil t)\n                 (if (minibufferp)\n                     (1+ (point))\n                   (point)))))\n        (end (point))\n        (collection-fn (completion-table-dynamic\n                        ;; The manual seems to show the FUN ignoring any\n                        ;; arguments, but the `completion-table-dynamic' docstring\n                        ;; seems to say that it should use the argument.\n                        (lambda (_ignore)\n                          (ement-room--member-names-and-ids)))))\n    (when beg\n      (list beg end collection-fn :exclusive 'no))))\n\n(defun ement-room--complete-rooms-at-point ()\n  \"Complete room aliases and IDs at point.\nFor use in `completion-at-point-functions'.\"\n  (let ((beg (save-excursion\n               (when (re-search-backward (rx (or bol bos blank) (or \"!\" \"#\")) nil t)\n                 (if (minibufferp)\n                     (1+ (point))\n                   (point)))))\n        (end (point))\n        (collection-fn (completion-table-dynamic\n                        ;; The manual seems to show the FUN ignoring any\n                        ;; arguments, but the `completion-table-dynamic' docstring\n                        ;; seems to say that it should use the argument.\n                        (lambda (_ignore)\n                          (ement-room--room-aliases-and-ids)))))\n    (when beg\n      (list beg end collection-fn :exclusive 'no))))\n\n;; TODO: Use `cl-pushnew' in these two functions instead of `delete-dups'.\n\n(defun ement-room--member-names-and-ids ()\n  \"Return a list of member names and IDs seen in current room.\nIf room's `members' table is filled, use it; otherwise, fetch\nmembers list and return already-seen members instead.  For use in\n`completion-at-point-functions'.\"\n  ;; For now, we just collect a list of members from events we've seen.\n  ;; TODO: In the future, we may maintain a per-room table of members, which\n  ;; would be more suitable for completing names according to the spec.\n  (pcase-let* ((room (if (minibufferp)\n                         (buffer-local-value\n                          'ement-room (window-buffer (minibuffer-selected-window)))\n                       ement-room))\n               (session (if (minibufferp)\n                            (buffer-local-value\n                             'ement-session (window-buffer (minibuffer-selected-window)))\n                          ement-session))\n               ((cl-struct ement-room members) room)\n               (members (if (alist-get 'fetched-members-p (ement-room-local room))\n                            (hash-table-values members)\n                          ;; HACK: Members table empty: update list and use known events\n                          ;; for now.\n                          (ement-singly (alist-get 'getting-members-p (ement-room-local room))\n                            (ement--get-joined-members room session\n                              :then (lambda (_) (setf (alist-get 'getting-members-p (ement-room-local room)) nil))\n                              :else (lambda (_) (setf (alist-get 'getting-members-p (ement-room-local room)) nil))))\n                          (mapcar #'ement-event-sender\n                                  (ement-room-timeline ement-room)))))\n    (delete-dups\n     (cl-loop for member in members\n              collect (ement-user-id member)\n              collect (ement--user-displayname-in room member)))))\n\n(defun ement-room--room-aliases-and-ids ()\n  \"Return a list of room names and aliases seen in current session.\nFor use in `completion-at-point-functions'.\"\n  (let* ((session (if (minibufferp)\n                      (buffer-local-value\n                       'ement-session (window-buffer (minibuffer-selected-window)))\n                    ement-session)))\n    (delete-dups\n     (delq nil (cl-loop for room in (ement-session-rooms session)\n                        collect (ement-room-id room)\n                        collect (ement-room-canonical-alias room))))))\n\n;;;;; Transient\n\n(require 'transient)\n\n(transient-define-prefix ement-room-transient ()\n  \"Transient for Ement Room buffers.\"\n  [:pad-keys t\n             [\"Movement\"\n              (\"TAB\" \"Next event\" ement-room-goto-next)\n              (\"\" \"Previous event\" ement-room-goto-prev)\n              (\"SPC\" \"Scroll up and mark read\" ement-room-scroll-up-mark-read)\n              (\"S-SPC\" \"Scroll down\" ement-room-scroll-down-command)\n              (\"M-SPC\" \"Jump to fully-read marker\" ement-room-goto-fully-read-marker)]\n             [\"Switching\"\n              (\"M-g M-l\" \"List rooms\" ement-room-list)\n              (\"M-g M-r\" \"Switch to other room\" ement-view-room)\n              (\"M-g M-m\" \"Switch to mentions buffer\" ement-notify-switch-to-mentions-buffer)\n              (\"M-g M-n\" \"Switch to notifications buffer\" ement-notify-switch-to-notifications-buffer)\n              (\"q\" \"Quit window\" quit-window)]]\n  [:pad-keys t\n             [\"Messages\"\n              (\"c\" \"Composition format\" ement-room-set-composition-format\n               :description (lambda ()\n                              (concat \"Composition format: \"\n                                      (propertize (car (cl-rassoc ement-room-send-message-filter\n                                                                  (list (cons \"Plain-text\" nil)\n                                                                        (cons \"Org-mode\" 'ement-room-send-org-filter))\n                                                                  :test #'equal))\n                                                  'face 'transient-value))))\n              (\"RET\" \"Write message\" ement-room-send-message)\n              (\"S-RET\" \"Write reply\" ement-room-write-reply)\n              (\"M-RET\" \"Compose message in buffer\" ement-room-compose-message)\n              (\"\" \"Edit message\" ement-room-edit-message)\n              (\"C-k\" \"Delete message\" ement-room-delete-message)\n              (\"s r\" \"Send reaction\" ement-room-send-reaction)\n              (\"s e\" \"Send emote\" ement-room-send-emote)\n              (\"s f\" \"Send file\" ement-room-send-file)\n              (\"s i\" \"Send image\" ement-room-send-image)]\n             [\"Users\"\n              (\"u RET\" \"Send direct message\" ement-send-direct-message)\n              (\"u i\" \"Invite user\" ement-invite-user)\n              (\"u I\" \"Ignore user\" ement-ignore-user)]]\n  [:pad-keys t\n             [\"Room\"\n              (\"M-s o\" \"Occur search in room\" ement-room-occur)\n              (\"r d\" \"Describe room\" ement-describe-room)\n              (\"r m\" \"List members\" ement-list-members)\n              (\"r t\" \"Set topic\" ement-room-set-topic)\n              (\"r f\" \"Set message format\" ement-room-set-message-format)\n              (\"r N\" \"Override name\" ement-room-override-name\n               :description (lambda ()\n                              (format \"Name override: %s\"\n                                      (if-let* ((event (alist-get \"org.matrix.msc3015.m.room.name.override\"\n                                                                  (ement-room-account-data ement-room) nil nil #'equal))\n                                                (name (map-nested-elt event '(content name))))\n                                          (propertize name 'face 'transient-value)\n                                        (propertize \"none\" 'face 'transient-inactive-value)))))\n              (\"r n\" \"Set notification state\" ement-room-set-notification-state\n               :description (lambda ()\n                              (let ((state (ement-room-notification-state ement-room ement-session)))\n                                (format \"Notifications (%s|%s|%s|%s|%s)\"\n                                        (propertize \"default\"\n                                                    'face (pcase state\n                                                            (`nil 'transient-value)\n                                                            (_ 'transient-inactive-value)))\n                                        (propertize \"all-loud\"\n                                                    'face (pcase state\n                                                            ('all-loud 'transient-value)\n                                                            (_ 'transient-inactive-value)))\n                                        (propertize \"all\"\n                                                    'face (pcase state\n                                                            ('all 'transient-value)\n                                                            (_ 'transient-inactive-value)))\n                                        (propertize \"mentions\"\n                                                    'face (pcase state\n                                                            ('mentions-and-keywords 'transient-value)\n                                                            (_ 'transient-inactive-value)))\n                                        (propertize \"none\"\n                                                    'face (pcase state\n                                                            ('none 'transient-value)\n                                                            (_ 'transient-inactive-value)))))))\n              (\"r T\" \"Tag/untag room\" ement-tag-room\n               :description (lambda ()\n                              (format \"Tag/untag room (%s|%s)\"\n                                      (propertize \"Fav\"\n                                                  'face (if (ement--room-tagged-p \"m.favourite\" ement-room)\n                                                            'transient-value 'transient-inactive-value))\n                                      (propertize \"Low-prio\"\n                                                  'face (if (ement--room-tagged-p \"m.lowpriority\" ement-room)\n                                                            'transient-value 'transient-inactive-value)))))]\n             [\"Room membership\"\n              (\"R c\" \"Create room\" ement-create-room)\n              (\"R j\" \"Join room\" ement-join-room)\n              (\"R l\" \"Leave room\" ement-leave-room)\n              (\"R F\" \"Forget room\" ement-forget-room)\n              (\"R n\" \"Set nick\" ement-room-set-display-name\n               :description (lambda ()\n                              (format \"Set nick (%s)\"\n                                      (propertize (ement--user-displayname-in\n                                                   ement-room (gethash (ement-user-id (ement-session-user ement-session))\n                                                                       ement-users))\n                                                  'face 'transient-value))))\n              (\"R s\" \"Toggle spaces\" ement-room-toggle-space\n               :description (lambda ()\n                              (format \"Toggle spaces (%s)\"\n                                      (if-let ((spaces (ement--room-spaces ement-room ement-session)))\n                                          (string-join\n                                           (mapcar (lambda (space)\n                                                     (propertize (ement-room-display-name space)\n                                                                 'face 'transient-value))\n                                                   spaces)\n                                           \", \")\n                                        (propertize \"none\" 'face 'transient-inactive-value)))))]]\n  [\"Other\"\n   (\"v\" \"View event\" ement-room-view-event)\n   (\"g\" \"Sync new messages\" ement-room-sync\n    :if (lambda ()\n          (interactive)\n          (or (not ement-auto-sync)\n              (not (map-elt ement-syncs ement-session)))))])\n\n;;;; Footer\n\n(provide 'ement-room)\n\n;;; ement-room.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-structs.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1623473,"end":1623513},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1623513},"to":{"change":3,"start":1620344,"end":1620344},"introduced_by":3}],"inode":{"change":3,"pos":1620344}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1620344},"to":{"change":3,"start":1620345,"end":1623472},"introduced_by":3}],"inode":{"change":3,"pos":1620344}},"content":[{"Del":";;; ement-structs.el --- Ement structs               -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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;;;; Debugging\n\n;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable\n;; `ement-debug' messages.  This is commented out by default because, even though the\n;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if\n;; that is so at expansion time, the expanded macro calls format the message and check the\n;; log level at runtime, which is not zero-cost.\n\n;; (eval-and-compile\n;;   (setq-local warning-minimum-log-level nil)\n;;   (setq-local warning-minimum-log-level :debug))\n\n;;;; Requirements\n\n(require 'cl-lib)\n\n;;;; Structs\n\n(cl-defstruct ement-user\n  id displayname account-data\n  (color nil :documentation \"Color in which to display user's name.\")\n  (message-color nil :documentation \"Color in which to display user's messages.\")\n  (username nil\n            ;; NOTE: Not exactly according to spec, I guess, but useful for now.\n            :documentation \"Username part of user's Matrix ID.\")\n  (avatar-url nil :documentation \"MXC URL to user's avatar.\")\n  (avatar nil :documentation \"One-space string with avatar image in display property.\"))\n\n(cl-defstruct ement-event\n  id sender content origin-server-ts type unsigned state-key\n  receipts\n  ;; The local slot is an alist used by the local client only.\n  local)\n\n(cl-defstruct ement-server\n  name uri-prefix)\n\n(cl-defstruct ement-session\n  user server token transaction-id rooms next-batch\n  device-id initial-device-display-name has-synced-p\n  account-data\n  ;; Hash table of all seen events, keyed on event ID.\n  events)\n\n(cl-defstruct ement-room\n  id display-name prev-batch\n  summary state timeline ephemeral account-data unread-notifications\n  latest-ts topic canonical-alias avatar status type invite-state\n  (members (make-hash-table :test #'equal) :documentation \"Hash table mapping joined user IDs to user structs.\")\n  ;; The local slot is an alist used by the local client only.\n  local\n  (receipts (make-hash-table :test #'equal))\n  (displaynames (make-hash-table) :documentation \"Hash table mapping users to their displayname in this room.\"))\n\n;;;; Variables\n\n\n;;;; Customization\n\n\n;;;; Commands\n\n\n;;;; Functions\n\n\n;;;; Footer\n\n(provide 'ement-structs)\n\n;;; ement-structs.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement-tabulated-room-list.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1620290,"end":1620342},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1620342},"to":{"change":3,"start":1597363,"end":1597363},"introduced_by":3}],"inode":{"change":3,"pos":1597363}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1597363},"to":{"change":3,"start":1597364,"end":1620289},"introduced_by":3}],"inode":{"change":3,"pos":1597363}},"content":[{"Del":";;; ement-tabulated-room-list.el --- Ement tabulated room list buffer    -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \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 library implements a room list buffer with `tabulated-list-mode'.\n\n;; NOTE: It doesn't appear that there is a way to get the number of\n;; members in a room other than by retrieving the list of members and\n;; counting them.  For a large room (e.g. the Spacemacs Gitter room or\n;; #debian:matrix.org), that means thousands of users, none of the\n;; details of which we care about.  So it seems impractical to know\n;; the number of members when using lazy-loading.  So I guess we just\n;; won't show the number of members.\n\n;; TODO: (Or maybe there is, see m.joined_member_count).\n\n;; NOTE: The tabulated-list API is awkward here.  When the\n;; `tabulated-list-format' is changed, we have to make the change in 4\n;; or 5 other places, and if one forgets to, bugs with non-obvious\n;; causes happen.  I think library using EIEIO or structs would be\n;; very helpful.\n\n;;; Code:\n\n;;;; Requirements\n\n(require 'cl-lib)\n(require 'tabulated-list)\n\n(require 'ement)\n\n;;;; Variables\n\n(declare-function ement-notify-switch-to-mentions-buffer \"ement-notify\")\n(declare-function ement-notify-switch-to-notifications-buffer \"ement-notify\")\n(defvar ement-tabulated-room-list-mode-map\n  (let ((map (make-sparse-keymap)))\n    ;; (define-key map (kbd \"g\") #'tabulated-list-revert)\n    ;; (define-key map (kbd \"q\") #'bury-buffer)\n    (define-key map (kbd \"SPC\") #'ement-tabulated-room-list-next-unread)\n    (define-key map (kbd \"M-g M-m\") #'ement-notify-switch-to-mentions-buffer)\n    (define-key map (kbd \"M-g M-n\") #'ement-notify-switch-to-notifications-buffer)\n    ;; (define-key map (kbd \"S\") #'tabulated-list-sort)\n    map))\n\n(defvar ement-tabulated-room-list-timestamp-colors nil\n  \"List of colors used for timestamps.\nSet automatically when `ement-tabulated-room-list-mode' is activated.\")\n\n(defvar ement-sessions)\n\n;;;; Customization\n\n(defgroup ement-tabulated-room-list nil\n  \"Options for the room list buffer.\"\n  :group 'ement)\n\n(defcustom ement-tabulated-room-list-auto-update t\n  \"Automatically update the room list buffer.\"\n  :type 'boolean)\n\n(defcustom ement-tabulated-room-list-avatars (display-images-p)\n  \"Show room avatars in the room list.\"\n  :type 'boolean)\n\n(defcustom ement-tabulated-room-list-simplify-timestamps t\n  \"Only show the largest unit of time in a timestamp.\nFor example, \\\"1h54m3s\\\" becomes \\\"1h\\\".\"\n  :type 'boolean)\n\n;;;;; Faces\n\n(defface ement-tabulated-room-list-name\n  '((t (:inherit font-lock-function-name-face button)))\n  \"Non-direct rooms.\")\n\n(defface ement-tabulated-room-list-direct\n  ;; In case `font-lock-constant-face' is bold, we set the weight to normal, so it can be\n  ;; made bold for unread rooms only.\n  '((t (:weight normal :inherit (font-lock-constant-face ement-tabulated-room-list-name))))\n  \"Direct rooms.\")\n\n(defface ement-tabulated-room-list-invited\n  '((t (:inherit italic ement-tabulated-room-list-name)))\n  \"Invited rooms.\")\n\n(defface ement-tabulated-room-list-left\n  '((t (:strike-through t :inherit ement-tabulated-room-list-name)))\n  \"Left rooms.\")\n\n(defface ement-tabulated-room-list-unread\n  '((t (:inherit bold ement-tabulated-room-list-name)))\n  \"Unread rooms.\")\n\n(defface ement-tabulated-room-list-favourite '((t (:inherit (font-lock-doc-face ement-tabulated-room-list-name))))\n  \"Favourite rooms.\")\n\n(defface ement-tabulated-room-list-low-priority '((t (:inherit (font-lock-comment-face ement-tabulated-room-list-name))))\n  \"Low-priority rooms.\")\n\n(defface ement-tabulated-room-list-recent\n  '((t (:inherit font-lock-warning-face)))\n  \"Latest timestamp of recently updated rooms.\nThe foreground color is used to generate a gradient of colors\nfrom recent to non-recent for rooms updated in the past 24\nhours but at least one hour ago.\")\n\n(defface ement-tabulated-room-list-very-recent\n  '((t (:inherit error)))\n  \"Latest timestamp of very recently updated rooms.\nThe foreground color is used to generate a gradient of colors\nfrom recent to non-recent for rooms updated in the past hour.\")\n\n;;;; Bookmark support\n\n;; Especially useful with Burly: \n\n(require 'bookmark)\n\n(defun ement-tabulated-room-list-bookmark-make-record ()\n  \"Return a bookmark record for the `ement-tabulated-room-list' buffer.\"\n  (pcase-let* (((cl-struct ement-session user) ement-session)\n               ((cl-struct ement-user (id session-id)) user))\n    ;; MAYBE: Support bookmarking specific events in a room.\n    (list (concat \"Ement room list (\" session-id \")\")\n          (cons 'session-id session-id)\n          (cons 'handler #'ement-tabulated-room-list-bookmark-handler))))\n\n(defun ement-tabulated-room-list-bookmark-handler (bookmark)\n  \"Show Ement room list buffer for BOOKMARK.\"\n  (pcase-let* (((map session-id) bookmark))\n    (unless (alist-get session-id ement-sessions nil nil #'equal)\n      ;; MAYBE: Automatically connect.\n      (user-error \"Session %s not connected: call `ement-connect' first\" session-id))\n    (ement-tabulated-room-list)))\n\n;;;; Commands\n\n(defun ement-tabulated-room-list-next-unread ()\n  \"Show next unread room.\"\n  (interactive)\n  (unless (button-at (point))\n    (call-interactively #'forward-button))\n  (unless (cl-loop with starting-line = (line-number-at-pos)\n                   if (equal \"U\" (elt (tabulated-list-get-entry) 0))\n                   do (progn\n                        (goto-char (button-end (button-at (point))))\n                        (push-button (1- (point)))\n                        (cl-return t))\n                   else do (call-interactively #'forward-button)\n                   while (> (line-number-at-pos) starting-line))\n    ;; No more unread rooms.\n    (message \"No more unread rooms\")))\n\n;;;###autoload\n(defun ement-tabulated-room-list (&rest _ignore)\n  \"Show buffer listing joined rooms.\nCalls `pop-to-buffer-same-window'.  Interactively, with prefix,\ncall `pop-to-buffer'.\"\n  (interactive)\n  (with-current-buffer (get-buffer-create \"*Ement Rooms*\")\n    (ement-tabulated-room-list-mode)\n    (setq-local bookmark-make-record-function #'ement-tabulated-room-list-bookmark-make-record)\n    ;; FIXME: There must be a better way to handle this.\n    (funcall (if current-prefix-arg\n                 #'pop-to-buffer #'pop-to-buffer-same-window)\n             (current-buffer))))\n\n(defun ement-tabulated-room-list--timestamp-colors ()\n  \"Return a vector of generated latest-timestamp colors for rooms.\nUsed in `ement-tabulated-room-list' and `ement-room-list'.\"\n  (if (or (equal \"unspecified-fg\" (face-foreground 'default nil 'default))\n          (equal \"unspecified-bg\" (face-background 'default nil 'default)))\n      ;; NOTE: On a TTY, the default face's foreground and background colors may be the\n      ;; special values \"unspecified-fg\"/\"unspecified-bg\", in which case we can't generate\n      ;; gradients, so we just return a vector of \"unspecified-fg\".  See\n      ;; .\n      (make-vector 134 \"unspecified-fg\")\n    (cl-coerce\n     (append (mapcar\n              ;; One face per 10-minute period, from \"recent\" to 1-hour.\n              (lambda (rgb)\n                (pcase-let ((`(,r ,g ,b) rgb))\n                  (color-rgb-to-hex r g b 2)))\n              (color-gradient (color-name-to-rgb (face-foreground 'ement-tabulated-room-list-very-recent\n                                                                  nil 'default))\n                              (color-name-to-rgb (face-foreground 'ement-tabulated-room-list-recent\n                                                                  nil 'default))\n                              6))\n             (mapcar\n              ;; One face per hour, from \"recent\" to default.\n              (lambda (rgb)\n                (pcase-let ((`(,r ,g ,b) rgb))\n                  (color-rgb-to-hex r g b 2)))\n              (color-gradient (color-name-to-rgb (face-foreground 'ement-tabulated-room-list-recent\n                                                                  nil 'default))\n                              (color-name-to-rgb (face-foreground 'default nil 'default))\n                              24))\n             (mapcar\n              ;; One face per week for the last year (actually we\n              ;; generate colors for the past two years' worth so\n              ;; that the face for one-year-ago is halfway to\n              ;; invisible, and we don't use colors past that point).\n              (lambda (rgb)\n                (pcase-let ((`(,r ,g ,b) rgb))\n                  (color-rgb-to-hex r g b 2)))\n              (color-gradient (color-name-to-rgb (face-foreground 'default nil 'default))\n                              (color-name-to-rgb (face-background 'default nil 'default))\n                              104)))\n     'vector)))\n\n(define-derived-mode ement-tabulated-room-list-mode tabulated-list-mode\n  \"Ement-Tabulated-Room-List\"\n  :group 'ement\n  (setf tabulated-list-format (vector\n                               '(\"U\" 1 t)\n                               '(#(\"P\" 0 1 (help-echo \"Priority (favorite/low)\")) 1 t)\n                               '(\"B\" 1 t)\n                               ;; '(\"U\" 1 t)\n                               '(\"d\" 1 t) ; Direct\n                               (list (propertize \"🐱\"\n                                                 'help-echo \"Avatar\")\n                                     4 t) ; Avatar\n                               '(\"Name\" 25 t) '(\"Topic\" 35 t)\n                               (list \"Latest\"\n                                     (if ement-tabulated-room-list-simplify-timestamps\n                                         6 20)\n                                     #'ement-tabulated-room-list-latest<\n\t\t\t\t     :right-align t)\n                               '(\"Members\" 7 ement-tabulated-room-list-members<)\n                               ;; '(\"P\" 1 t) '(\"Tags\" 15 t)\n                               '(\"Session\" 15 t))\n        tabulated-list-sort-key '(\"Latest\" . t)\n        ement-tabulated-room-list-timestamp-colors (ement-tabulated-room-list--timestamp-colors))\n  (add-hook 'tabulated-list-revert-hook #'ement-tabulated-room-list--set-entries nil 'local)\n  (tabulated-list-init-header)\n  (ement-tabulated-room-list--set-entries)\n  (tabulated-list-revert))\n\n(defun ement-tabulated-room-list-action (event)\n  \"Show buffer for room at EVENT or point.\"\n  (interactive \"e\")\n  (mouse-set-point event)\n  (pcase-let* ((room (tabulated-list-get-id))\n               (`[,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name ,_topic ,_latest ,_members ,user-id]\n                (tabulated-list-get-entry))\n               (session (alist-get user-id ement-sessions nil nil #'equal)))\n    (ement-view-room room session)))\n\n;;;; Functions\n\n;;;###autoload\n(defun ement-tabulated-room-list-auto-update (_session)\n  \"Automatically update the room list buffer.\nDoes so when variable `ement-tabulated-room-list-auto-update' is non-nil.\nTo be called in `ement-sync-callback-hook'.\"\n  (when (and ement-tabulated-room-list-auto-update\n             (buffer-live-p (get-buffer \"*Ement Rooms*\")))\n    (with-current-buffer (get-buffer \"*Ement Rooms*\")\n      (revert-buffer))))\n\n(defun ement-tabulated-room-list--set-entries ()\n  \"Set `tabulated-list-entries'.\"\n  ;; Reset avatar size in case default font size has changed.\n  ;; TODO: After implementing avatars.\n  ;; (customize-set-variable 'ement-room-avatar-in-buffer-name-size ement-room-avatar-in-buffer-name-size)\n\n  ;; NOTE: From Emacs docs:\n\n  ;; This buffer-local variable specifies the entries displayed in the\n  ;; Tabulated List buffer.  Its value should be either a list, or a\n  ;; function.\n  ;;\n  ;; If the value is a list, each list element corresponds to one entry,\n  ;; and should have the form ‘(ID CONTENTS)’, where\n  ;;\n  ;; • ID is either ‘nil’, or a Lisp object that identifies the\n  ;; entry.  If the latter, the cursor stays on the same entry when\n  ;; re-sorting entries.  Comparison is done with ‘equal’.\n  ;;\n  ;; • CONTENTS is a vector with the same number of elements as\n  ;; ‘tabulated-list-format’.  Each vector element is either a\n  ;;  string, which is inserted into the buffer as-is, or a list\n  ;;  ‘(LABEL . PROPERTIES)’, which means to insert a text button by\n  ;;   calling ‘insert-text-button’ with LABEL and PROPERTIES as\n  ;;   arguments (*note Making Buttons::).\n  ;;\n  ;;   There should be no newlines in any of these strings.\n  (let ((entries (cl-loop for (_id . session) in ement-sessions\n                          append (mapcar (lambda (room)\n                                           (ement-tabulated-room-list--entry session room))\n                                         (ement-session-rooms session)))))\n    (setf tabulated-list-entries\n          ;; Pre-sort by latest event so that, when the list is sorted by other columns,\n          ;; the rooms will be secondarily sorted by latest event.\n          (cl-sort entries #'> :key (lambda (entry)\n                                      ;; In case a room has no latest event (not sure if\n                                      ;; this may obscure a bug, but this has happened, so\n                                      ;; we need to handle it), we fall back to 0.\n                                      (or (ement-room-latest-ts (car entry)) 0))))))\n\n(defun ement-tabulated-room-list--entry (session room)\n  \"Return entry for ROOM in SESSION for `tabulated-list-entries'.\"\n  (pcase-let* (((cl-struct ement-room id canonical-alias display-name avatar topic latest-ts summary\n                           (local (map buffer room-list-avatar)))\n                room)\n               ((map ('m.joined_member_count member-count)) summary)\n               (e-alias (or canonical-alias\n                            (setf (ement-room-canonical-alias room)\n                                  (ement--room-alias room))\n                            id))\n               ;; FIXME: Figure out how to track unread status cleanly.\n               (e-unread (if (and buffer (buffer-modified-p buffer))\n                             (propertize \"U\" 'help-echo \"Unread\") \"\"))\n               (e-buffer (if buffer (propertize \"B\" 'help-echo \"Room has buffer\") \"\"))\n               (e-avatar (if (and ement-tabulated-room-list-avatars avatar)\n                             (or room-list-avatar\n                                 (if-let* ((avatar-image (get-text-property 0 'display avatar))\n                                           (new-avatar-string (propertize \" \" 'display\n                                                                          (ement--resize-image avatar-image\n                                                                                               nil (frame-char-height)))))\n                                     (progn\n                                       ;; alist-get doesn't seem to return the new value when used with setf?\n                                       (setf (alist-get 'room-list-avatar (ement-room-local room))\n                                             new-avatar-string)\n                                       new-avatar-string)\n                                   ;; If a room avatar image fails to download or decode\n                                   ;; and ends up nil, we return the empty string.\n                                   (ement-debug \"nil avatar for room: \" (ement-room-display-name room) (ement-room-canonical-alias room))\n                                   \"\"))\n                           ;; Room avatars disabled.\n                           \"\"))\n               ;; We have to copy the list, otherwise using `setf' on it\n               ;; later causes its value to be mutated for every entry.\n               (name-face (cl-copy-list '(:inherit (ement-tabulated-room-list-name))))\n               (e-name (list (propertize (or display-name\n                                             (ement--room-display-name room))\n                                         ;; HACK: Apply face here, otherwise tabulated-list overrides it.\n                                         'face name-face\n                                         'help-echo e-alias)\n                             'action #'ement-tabulated-room-list-action))\n               (e-topic (if topic\n                            ;; Remove newlines from topic.  Yes, this can happen.\n                            (replace-regexp-in-string \"\\n\" \"\" topic t t)\n                          \"\"))\n               (formatted-timestamp (if latest-ts\n                                        (ement--human-format-duration (- (time-convert nil 'integer) (/ latest-ts 1000))\n                                                                      t)\n                                      \"\"))\n               (latest-face (when latest-ts\n                              (let* ((difference-seconds (- (float-time) (/ latest-ts 1000))  )\n                                     (n (cl-typecase difference-seconds\n                                          ((number 0 3599) ;; 1 hour to 1 day: 24 1-hour periods.\n                                           (truncate (/ difference-seconds 600)))\n                                          ((number 3600 86400) ;; 1 day\n                                           (+ 6 (truncate (/ difference-seconds 3600))))\n                                          (otherwise ;; Difference in weeks.\n                                           (min (/ (length ement-tabulated-room-list-timestamp-colors) 2)\n                                                (+ 24 (truncate (/ difference-seconds 86400 7))))))))\n                                (list :foreground (elt ement-tabulated-room-list-timestamp-colors n)))))\n               (e-latest (or (when formatted-timestamp\n                               (propertize formatted-timestamp\n                                           'value latest-ts\n                                           'face latest-face))\n                             ;; Invited rooms don't have a latest-ts.\n                             \"\"))\n               (e-session (propertize (ement-user-id (ement-session-user session))\n                                      'value session))\n               ;;  ((e-tags favorite-p low-priority-p) (ement-tabulated-room-list--tags room))\n               (e-direct-p (if (ement--room-direct-p room session)\n                               (propertize \"d\" 'help-echo \"Direct room\")\n                             \"\"))\n               (e-priority (cond ((ement--room-favourite-p room) \"F\")\n                                 ((ement--room-low-priority-p room) \"l\")\n                                 (\" \")))\n               (e-members (if member-count (number-to-string member-count) \"\")))\n    (when ement-tabulated-room-list-simplify-timestamps\n      (setf e-latest (replace-regexp-in-string\n                      (rx bos (1+ digit) (1+ alpha) (group (1+ (1+ digit) (1+ alpha))))\n                      \"\" e-latest t t 1)))\n    ;; Add face modifiers.\n    (when (and buffer (buffer-modified-p buffer))\n      ;; For some reason, `push' doesn't work with `map-elt'.\n      (setf (map-elt name-face :inherit)\n            (cons 'ement-tabulated-room-list-unread (map-elt name-face :inherit))))\n    (when (ement--room-direct-p room session)\n      (setf (map-elt name-face :inherit)\n            (cons 'ement-tabulated-room-list-direct (map-elt name-face :inherit))))\n    (when (ement--room-favourite-p room)\n      (push 'ement-tabulated-room-list-favourite (map-elt name-face :inherit)))\n    (when (ement--room-low-priority-p room)\n      (push 'ement-tabulated-room-list-low-priority (map-elt name-face :inherit)))\n    (pcase (ement-room-type room)\n      ('invite\n       (setf e-topic (concat (propertize \"[invited]\"\n                                         'face 'ement-tabulated-room-list-invited)\n                             \" \" e-topic)\n             (map-elt name-face :inherit) (cons 'ement-tabulated-room-list-invited\n                                                (map-elt name-face :inherit))))\n      ('leave\n       (setf e-topic (concat (propertize \"[left]\"\n                                         'face 'ement-tabulated-room-list-left)\n                             \" \" e-topic)\n             (map-elt name-face :inherit) (cons (map-elt name-face :inherit)\n                                                'ement-tabulated-room-list-left))))\n    (list room (vector e-unread e-priority e-buffer e-direct-p\n                       e-avatar e-name e-topic e-latest e-members\n                       ;; e-tags\n                       e-session\n                       ;; e-avatar\n                       ))))\n\n;; TODO: Define sorters with a macro?  This gets repetitive and hard to update.\n\n(defun ement-tabulated-room-list-members< (a b)\n  \"Return non-nil if entry A has fewer members than room B.\nA and B should be entries from `tabulated-list-mode'.\"\n  (pcase-let* ((`(,_room [,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,_latest ,a-members ,_session]) a)\n               (`(,_room [,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,_latest ,b-members ,_session]) b))\n    (when (and a-members b-members)\n      ;; Invited rooms may have no member count (I think).\n      (< (string-to-number a-members) (string-to-number b-members)))))\n\n(defun ement-tabulated-room-list-latest< (a b)\n  \"Return non-nil if entry A has fewer members than room B.\nA and B should be entries from `tabulated-list-mode'.\"\n  (pcase-let* ((`(,_room-a [,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,a-latest ,_a-members ,_session]) a)\n               (`(,_room-b [,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,b-latest ,_b-members ,_session]) b)\n               (a-latest (get-text-property 0 'value a-latest))\n               (b-latest (get-text-property 0 'value b-latest)))\n    (cond ((and a-latest b-latest)\n           (< a-latest b-latest))\n          (b-latest\n           ;; Invited rooms have no latest timestamp, and we want to sort them first.\n           nil)\n          (t t))))\n\n;;;; Footer\n\n(provide 'ement-tabulated-room-list)\n\n;;; ement-tabulated-room-list.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1597329,"end":1597361},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1597361},"to":{"change":3,"start":1544007,"end":1544007},"introduced_by":3}],"inode":{"change":3,"pos":1544007}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1544007},"to":{"change":3,"start":1544008,"end":1597328},"introduced_by":3}],"inode":{"change":3,"pos":1544007}},"content":[{"Del":";;; ement.el --- Matrix client                       -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2022  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \n;; URL: https://github.com/alphapapa/ement.el\n;; Version: 0.9.2\n;; Package-Requires: ((emacs \"27.1\") (map \"2.1\") (persist \"0.5\") (plz \"0.2\") (taxy \"0.10\") (taxy-magit-section \"0.12.1\") (svg-lib \"0.2.5\") (transient \"0.3.7\"))\n;; Keywords: comm\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;; Another Matrix client!  This one is written from scratch and is\n;; intended to be more \"Emacsy,\" more suitable for MELPA, etc.  Also\n;; it has a shorter, perhaps catchier name, that is a mildly clever\n;; play on the name of the official Matrix client and the Emacs Lisp\n;; filename extension (oops, I explained the joke), which makes for\n;; much shorter symbol names.\n\n;; This file implements the core client library.  Functions that may be called in multiple\n;; files belong in `ement-lib'.\n\n;;; Code:\n\n;;;; Debugging\n\n;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable\n;; `ement-debug' messages.  This is commented out by default because, even though the\n;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if\n;; that is so at expansion time, the expanded macro calls format the message and check the\n;; log level at runtime, which is not zero-cost.\n\n;; (eval-and-compile\n;;   (require 'warnings)\n;;   (setq-local warning-minimum-log-level nil)\n;;   (setq-local warning-minimum-log-level :debug))\n\n;;;; Requirements\n\n;; Built in.\n(require 'cl-lib)\n(require 'dns)\n(require 'files)\n(require 'map)\n\n;; This package.\n(require 'ement-lib)\n(require 'ement-room)\n(require 'ement-notify)\n\n;;;; Variables\n\n(defvar ement-sessions nil\n  \"Alist of active `ement-session' sessions, keyed by MXID.\")\n\n(defvar ement-syncs nil\n  \"Alist of outstanding sync processes for each session.\")\n\n(defvar ement-users (make-hash-table :test #'equal)\n  ;; NOTE: When changing the ement-user struct, it's necessary to\n  ;; reset this table to clear old-type structs.\n  \"Hash table storing user structs keyed on user ID.\")\n\n(defvar ement-progress-reporter nil\n  \"Used to report progress while processing sync events.\")\n\n(defvar ement-progress-value nil\n  \"Used to report progress while processing sync events.\")\n\n(defvar ement-sync-callback-hook\n  '(ement--update-room-buffers ement--auto-sync ement-tabulated-room-list-auto-update\n                               ement-room-list-auto-update)\n  \"Hook run after `ement--sync-callback'.\nHooks are called with one argument, the session that was\nsynced.\")\n\n(defvar ement-event-hook\n  '(ement-notify ement--process-event ement--put-event)\n  \"Hook called for events.\nEach function is called with three arguments: the event, the\nroom, and the session.  This hook isn't intended to be modified\nby users; ones who do so should know what they're doing.\")\n\n(defvar ement-default-sync-filter\n  '((room (state (lazy_load_members . t))\n          (timeline (lazy_load_members . t))))\n  \"Default filter for sync requests.\")\n\n(defvar ement-images-queue (make-plz-queue :limit 5)\n  \"`plz' HTTP request queue for image requests.\")\n\n(defvar ement-read-receipt-idle-timer nil\n  \"Idle timer used to update read receipts.\")\n\n;; From other files.\n(defvar ement-room-avatar-max-width)\n(defvar ement-room-avatar-max-height)\n\n;;;; Customization\n\n(defgroup ement nil\n  \"Options for Ement, the Matrix client.\"\n  :group 'comm)\n\n(defcustom ement-save-sessions nil\n  \"Save session to disk.\nWrites the session file when Emacs is killed.\"\n  :type 'boolean\n  :set (lambda (option value)\n         (set-default option value)\n         (if value\n             (add-hook 'kill-emacs-hook #'ement--kill-emacs-hook)\n           (remove-hook 'kill-emacs-hook #'ement--kill-emacs-hook))))\n\n(defcustom ement-sessions-file \"~/.cache/ement.el\"\n  ;; FIXME: Expand correct XDG cache directory (new in Emacs 27).\n  \"Save username and access token to this file.\"\n  :type 'file)\n\n(defcustom ement-auto-sync t\n  \"Automatically sync again after syncing.\"\n  :type 'boolean)\n\n(defcustom ement-after-initial-sync-hook\n  '(ement-room-list--after-initial-sync ement-view-initial-rooms ement--link-children ement--run-idle-timer)\n  \"Hook run after initial sync.\nRun with one argument, the session synced.\"\n  :type 'hook)\n\n(defcustom ement-initial-sync-timeout 40\n  \"Timeout in seconds for initial sync requests.\nFor accounts in many rooms, the Matrix server may take some time\nto prepare the initial sync response, and increasing this timeout\nmight be necessary.\"\n  :type 'integer)\n\n(defcustom ement-auto-view-rooms nil\n  \"Rooms to view after initial sync.\nAlist mapping user IDs to a list of room aliases/IDs to open buffers for.\"\n  :type '(alist :key-type (string :tag \"Local user ID\")\n                :value-type (repeat (string :tag \"Room alias/ID\"))))\n\n(defcustom ement-disconnect-hook '(ement-kill-buffers ement--stop-idle-timer)\n  ;; FIXME: Put private functions in a private hook.\n  \"Functions called when disconnecting.\nThat is, when calling command `ement-disconnect'.  Functions are\ncalled with no arguments.\"\n  :type 'hook)\n\n(defcustom ement-view-room-display-buffer-action '(display-buffer-same-window)\n  \"Display buffer action to use when opening room buffers.\nSee function `display-buffer' and info node `(elisp) Buffer\nDisplay Action Functions'.\"\n  :type 'function)\n\n(defcustom ement-auto-view-room-display-buffer-action '(display-buffer-no-window)\n  \"Display buffer action to use when automatically opening room buffers.\nThat is, rooms listed in `ement-auto-view-rooms', which see.  See\nfunction `display-buffer' and info node `(elisp) Buffer Display\nAction Functions'.\"\n  :type 'function)\n\n(defcustom ement-interrupted-sync-hook '(ement-interrupted-sync-warning)\n  \"Functions to call when syncing of a session is interrupted.\nOnly called when `ement-auto-sync' is non-nil.  Functions are\ncalled with one argument, the session whose sync was interrupted.\n\nThis hook allows the user to customize how sync interruptions are\nhandled (e.g. how to be notified).\"\n  :type 'hook\n  :options '(ement-interrupted-sync-message ement-interrupted-sync-warning))\n\n;;;; Commands\n\n;;;###autoload\n(cl-defun ement-connect (&key user-id password uri-prefix session)\n  \"Connect to Matrix with USER-ID and PASSWORD, or using SESSION.\nInteractively, with prefix, ignore a saved session and log in\nagain; otherwise, use a saved session if `ement-save-sessions' is\nenabled and a saved session is available, or prompt to log in if\nnot enabled or available.\n\nIf USERID or PASSWORD are not specified, the user will be\nprompted for them.\n\nIf URI-PREFIX is specified, it should be the prefix of the\nserver's API URI, including protocol, hostname, and optionally\nthe port, e.g.\n\n  \\\"https://matrix-client.matrix.org\\\"\n  \\\"http://localhost:8080\\\"\"\n  (interactive (if current-prefix-arg\n                   ;; Force new session.\n                   (list :user-id (read-string \"User ID: \")\n                         :password (read-passwd \"Password: \"))\n                 ;; Use known session.\n                 (unless ement-sessions\n                   ;; Read sessions from disk.\n                   (condition-case err\n                       (setf ement-sessions (ement--read-sessions))\n                     (error (display-warning 'ement (format \"Unable to read session data from disk (%s).  Prompting to log in again.\"\n                                                            (error-message-string err))))))\n                 (cl-case (length ement-sessions)\n                   (0 (list :user-id (read-string \"User ID: \")\n                            :password (read-passwd \"Password: \")))\n                   (1 (list :session (cdar ement-sessions)))\n                   (otherwise (list :session (ement-complete-session))))))\n  (cl-labels ((new-session\n               () (unless (string-match (rx bos \"@\" (group (1+ (not (any \":\")))) ; Username\n                                            \":\" (group (optional (1+ (not (any blank)))))) ; Server name\n                                        user-id)\n                    (user-error \"Invalid user ID format: use @USERNAME:SERVER\"))\n               (let* ((username (match-string 1 user-id))\n                      (server-name (match-string 2 user-id))\n                      (uri-prefix (or uri-prefix (ement--hostname-uri server-name)))\n                      (user (make-ement-user :id user-id :username username))\n                      (server (make-ement-server :name server-name :uri-prefix uri-prefix))\n                      (transaction-id (ement--initial-transaction-id))\n                      (initial-device-display-name (format \"Ement.el: %s@%s\"\n                                                           ;; Just to be extra careful:\n                                                           (or user-login-name \"[unknown user-login-name]\")\n                                                           (or (system-name) \"[unknown system-name]\")))\n                      (device-id (secure-hash 'sha256 initial-device-display-name)))\n                 (make-ement-session :user user :server server :transaction-id transaction-id\n                                     :device-id device-id :initial-device-display-name initial-device-display-name\n                                     :events (make-hash-table :test #'equal))))\n              (password-login\n               () (pcase-let* (((cl-struct ement-session user device-id initial-device-display-name) session)\n                               ((cl-struct ement-user id) user)\n                               (data (ement-alist \"type\" \"m.login.password\"\n                                                  \"identifier\"\n                                                  (ement-alist \"type\" \"m.id.user\"\n                                                               \"user\" id)\n                                                  \"password\" password\n                                                  \"device_id\" device-id\n                                                  \"initial_device_display_name\" initial-device-display-name)))\n                    ;; TODO: Clear password in callback (if we decide to hold on to it for retrying login timeouts).\n                    (ement-api session \"login\" :method 'post :data (json-encode data)\n                      :then (apply-partially #'ement--login-callback session))))\n              (flows-callback\n               (data) (if (cl-loop for flow across (map-elt data 'flows)\n                                   thereis (equal (map-elt flow 'type) \"m.login.password\"))\n                          (progn\n                            (message \"Ement: Logging in with password...\")\n                            (password-login))\n                        (error \"Matrix server doesn't support m.login.password login flow.  Supported flows: %s\"\n                               (cl-loop for flow in (map-elt data 'flows)\n                                        collect (map-elt flow 'type))))))\n    (if session\n        ;; Start syncing given session.\n        (let ((user-id (ement-user-id (ement-session-user session))))\n          ;; HACK: If session is already in ement-sessions, this replaces it.  I think that's okay...\n          (setf (alist-get user-id ement-sessions nil nil #'equal) session)\n          (ement--sync session :timeout ement-initial-sync-timeout))\n      ;; Start password login flow.  Prompt for user ID and password\n      ;; if not given (i.e. if not called interactively.)\n      (unless user-id\n        (setf user-id (read-string \"User ID: \")))\n      (unless password\n        (setf password (read-passwd (format \"Password for %s: \" user-id))))\n      (setf session (new-session))\n      (when (ement-api session \"login\" :then #'flows-callback)\n        (message \"Ement: Checking server's login flows...\")))))\n\n(defun ement-disconnect (sessions)\n  \"Disconnect from SESSIONS.\nInteractively, with prefix, disconnect from all sessions.  If\n`ement-auto-sync' is enabled, stop syncing, and clear the session\ndata.  When enabled, write the session to disk.  Any existing\nroom buffers are left alive and can be read, but other commands\nin them won't work.\"\n  (interactive (list (if current-prefix-arg\n                         (mapcar #'cdr ement-sessions)\n                       (list (ement-complete-session)))))\n  (when ement-save-sessions\n    ;; Write sessions before we remove them from the variable.\n    (ement--write-sessions ement-sessions))\n  (dolist (session sessions)\n    (let ((user-id (ement-user-id (ement-session-user session))))\n      (when-let ((process (map-elt ement-syncs session)))\n        (ignore-errors\n          (delete-process process)))\n      ;; NOTE: I'd like to use `map-elt' here, but not until\n      ;;  is fixed, I guess.\n      (setf (alist-get session ement-syncs nil nil #'equal) nil\n            (alist-get user-id ement-sessions nil 'remove #'equal) nil)))\n  (unless ement-sessions\n    ;; HACK: If no sessions remain, clear the users table.  It might be best\n    ;; to store a per-session users table, but this is probably good enough.\n    (clrhash ement-users))\n  (run-hooks 'ement-disconnect-hook)\n  (message \"Ement: Disconnected (%s)\"\n           (string-join (cl-loop for session in sessions\n                                 collect (ement-user-id (ement-session-user session)))\n                        \", \")))\n\n(defun ement-kill-buffers ()\n  \"Kill all Ement buffers.\nUseful in, e.g. `ement-disconnect-hook', which see.\"\n  (interactive)\n  (dolist (buffer (buffer-list))\n    (when (string-prefix-p \"ement-\" (symbol-name (buffer-local-value 'major-mode buffer)))\n      (kill-buffer buffer))))\n\n(defun ement--login-callback (session data)\n  \"Record DATA from logging in to SESSION and do initial sync.\"\n  (pcase-let* (((cl-struct ement-session (user (cl-struct ement-user (id user-id)))) session)\n               ((map ('access_token token) ('device_id device-id)) data))\n    (setf (ement-session-token session) token\n          (ement-session-device-id session) device-id\n          (alist-get user-id ement-sessions nil nil #'equal) session)\n    (ement--sync session :timeout ement-initial-sync-timeout)))\n\n;;;; Functions\n\n(defun ement-interrupted-sync-warning (session)\n  \"Display a warning that syncing of SESSION was interrupted.\"\n  (display-warning\n   'ement\n   (format\n    (substitute-command-keys\n     \"\\\\Syncing of session <%s> was interrupted.  Use command `ement-room-sync' in a room buffer to retry.\")\n    (ement-user-id (ement-session-user session)))\n   :error))\n\n(defun ement-interrupted-sync-message (session)\n  \"Display a message that syncing of SESSION was interrupted.\"\n  (message\n   (substitute-command-keys\n    \"\\\\Syncing of session <%s> was interrupted.  Use command `ement-room-sync' in a room buffer to retry.\")\n   (ement-user-id (ement-session-user session))))\n\n(defun ement--run-idle-timer (&rest _ignore)\n  \"Run idle timer that updates read receipts.\nTo be called from `ement-after-initial-sync-hook'.  Timer is\nstored in `ement-read-receipt-idle-timer'.\"\n  (setf ement-read-receipt-idle-timer (run-with-idle-timer 3 t #'ement-room-read-receipt-idle-timer)))\n\n(defun ement--stop-idle-timer (&rest _ignore)\n  \"Stop idle timer stored in `ement-read-receipt-idle-timer'.\nTo be called from `ement-disconnect-hook'.\"\n  (when (timerp ement-read-receipt-idle-timer)\n    (cancel-timer ement-read-receipt-idle-timer)\n    (setf ement-read-receipt-idle-timer nil)))\n\n(defun ement-view-initial-rooms (session)\n  \"View rooms for SESSION configured in `ement-auto-view-rooms'.\"\n  (when-let (rooms (alist-get (ement-user-id (ement-session-user session))\n\t\t\t      ement-auto-view-rooms nil nil #'equal))\n    (dolist (alias/id rooms)\n      (when-let (room (cl-find-if (lambda (room)\n\t\t\t\t    (or (equal alias/id (ement-room-canonical-alias room))\n\t\t\t\t\t(equal alias/id (ement-room-id room))))\n\t\t\t\t  (ement-session-rooms session)))\n        (let ((ement-view-room-display-buffer-action ement-auto-view-room-display-buffer-action))\n          (ement-view-room room session))))))\n\n(defun ement--initial-transaction-id ()\n  \"Return an initial transaction ID for a new session.\"\n  ;; We generate a somewhat-random initial transaction ID to avoid potential conflicts in\n  ;; case, e.g. using Pantalaimon causes a transaction ID conflict.  See\n  ;; .\n  (cl-parse-integer\n   (secure-hash 'sha256 (prin1-to-string (list (current-time) (system-name))))\n   :end 8 :radix 16))\n\n(defsubst ement--sync-messages-p (session)\n  \"Return non-nil if sync-related messages should be shown for SESSION.\"\n  ;; For now, this seems like the best way.\n  (or (not (ement-session-has-synced-p session))\n      (not ement-auto-sync)))\n\n(defun ement--hostname-uri (hostname)\n  \"Return the \\\".well-known\\\" URI for server HOSTNAME.\nIf no URI is found, prompt the user for the hostname.\"\n  ;; FIXME: When fail-prompting, a URI should be returned, not just a hostname.\n  ;; SPEC:  (\"4.1   Well-known URI\")\n  (cl-labels ((fail-prompt\n               () (let ((input (read-string \"Auto-discovery of server's well-known URI failed.  Input server hostname, or leave blank to use server name: \")))\n                    (pcase input\n                      (\"\" hostname)\n                      (_ input))))\n              (parse (string)\n                     (if-let ((object (ignore-errors (json-read-from-string string))))\n                         ;; Return extracted value.\n                         (map-nested-elt object '(m.homeserver base_url))\n                       ;; Parsing error: FAIL_PROMPT.\n                       (fail-prompt))))\n    (condition-case err\n        (let ((response (plz 'get (concat \"https://\" hostname \"/.well-known/matrix/client\")\n                          :as 'response :then 'sync)))\n          (if (plz-response-p response)\n              (pcase (plz-response-status response)\n                (200 (parse (plz-response-body response)))\n                (404 (fail-prompt))\n                (_ (warn \"Ement: `plz' request for .well-known URI returned unexpected code: %s\"\n                         (plz-response-status response))\n                   (fail-prompt)))\n            (warn \"Ement: `plz' request for .well-known URI did not return a `plz' response\")\n            (fail-prompt)))\n      (error (warn \"Ement: `plz' request for .well-known URI signaled an error: %S\" err)\n             (fail-prompt)))))\n\n(cl-defun ement--sync (session &key force quiet\n                               (timeout 40) ;; Give the server an extra 10 seconds.\n                               (filter ement-default-sync-filter))\n  \"Send sync request for SESSION.\nIf SESSION has a `next-batch' token, it's used.  If FORCE, first\ndelete any outstanding sync processes.  If QUIET, don't show a\nmessage about syncing this time.  Cancel request after TIMEOUT\nseconds.\n\nFILTER may be an alist representing a raw event filter (i.e. not\na filter ID).  When unspecified, the value of\n`ement-default-sync-filter' is used.  The filter is encoded with\n`json-encode'.  To use no filter, specify FILTER as nil.\"\n  ;; SPEC: .\n  ;; TODO: Filtering: .\n  ;; TODO: Use a filter ID for default filter.\n  ;; TODO: Optionally, automatically sync again when HTTP request fails.\n  ;; TODO: Ensure that the process in (map-elt ement-syncs session) is live.\n  (when (map-elt ement-syncs session)\n    (if force\n        (condition-case err\n            (delete-process (map-elt ement-syncs session))\n          ;; Ensure the only error is the expected one from deleting the process.\n          (ement-api-error (cl-assert (equal \"curl process killed\" (plz-error-message (cl-third err))))\n                           (message \"Ement: Forcing new sync\")))\n      (user-error \"Ement: Already syncing this session\")))\n  (pcase-let* (((cl-struct ement-session next-batch) session)\n               (params (remove\n                        nil (list (list \"full_state\" (if next-batch \"false\" \"true\"))\n                                  (when filter\n                                    ;; TODO: Document filter arg.\n                                    (list \"filter\" (json-encode filter)))\n                                  (when next-batch\n                                    (list \"since\" next-batch))\n                                  (when next-batch\n                                    (list \"timeout\" \"30000\")))))\n               (sync-start-time (time-to-seconds))\n               ;; FIXME: Auto-sync again in error handler.\n               (process (ement-api session \"sync\" :params params\n                          :timeout timeout\n                          :then (apply-partially #'ement--sync-callback session)\n                          :else (lambda (plz-error)\n                                  (setf (map-elt ement-syncs session) nil)\n                                  ;; TODO: plz probably needs nicer error handling.\n                                  ;; Ideally we would use `condition-case', but since the\n                                  ;; error is signaled in `plz--sentinel'...\n                                  (pcase-let (((cl-struct plz-error curl-error response) plz-error)\n                                              (reason))\n                                    (cond ((when response\n                                             (pcase (plz-response-status response)\n                                               ((or 429 502) (setf reason \"failed\")))))\n                                          ((pcase curl-error\n                                             (`(28 . ,_) (setf reason \"timed out\")))))\n                                    (if reason\n                                        (if (not ement-auto-sync)\n                                            (run-hook-with-args 'ement-interrupted-sync-hook session)\n                                          (message \"Ement: Sync %s (%s).  Syncing again...\"\n                                                   reason (ement-user-id (ement-session-user session)))\n                                          ;; Set QUIET to allow the just-printed message to remain visible.\n                                          (ement--sync session :timeout timeout :quiet t))\n                                      ;; Unrecognized errors:\n                                      (pcase curl-error\n                                        (`(,code . ,message)\n                                         (signal 'ement-api-error (list (format \"Ement: Network error: %s: %s\" code message)\n                                                                        plz-error)))\n                                        (_ (signal 'ement-api-error (list \"Ement: Unrecognized network error\" plz-error)))))))\n                          :json-read-fn (lambda ()\n                                          \"Print a message, then call `json-read'.\"\n                                          (when (ement--sync-messages-p session)\n                                            (message \"Ement: Response arrived after %.2f seconds.  Reading %s JSON response...\"\n                                                     (- (time-to-seconds) sync-start-time)\n                                                     (file-size-human-readable (buffer-size))))\n                                          (let ((start-time (time-to-seconds)))\n                                            (prog1 (json-read)\n                                              (when (ement--sync-messages-p session)\n                                                (message \"Ement: Reading JSON took %.2f seconds\"\n                                                         (- (time-to-seconds) start-time)))))))))\n    (when process\n      (setf (map-elt ement-syncs session) process)\n      (when (and (not quiet) (ement--sync-messages-p session))\n        (message \"Ement: Sync request sent, waiting for response...\")))))\n\n(defun ement--sync-callback (session data)\n  \"Process sync DATA for SESSION.\nRuns `ement-sync-callback-hook' with SESSION.\"\n  ;; Remove the sync first.  We already have the data from it, and the\n  ;; process has exited, so it's safe to run another one.\n  (setf (map-elt ement-syncs session) nil)\n  (pcase-let* (((map rooms ('next_batch next-batch) ('account_data (map ('events account-data-events))))\n                data)\n               ((map ('join joined-rooms) ('invite invited-rooms) ('leave left-rooms)) rooms)\n               (num-events (+\n                            ;; HACK: In `ement--push-joined-room-events', we do something\n                            ;; with each event 3 times, so we multiply this by 3.\n                            ;; FIXME: That calculation doesn't seem to be quite right, because\n                            ;; the progress reporter never seems to hit 100% before it's done.\n                            (* 3 (cl-loop for (_id . room) in joined-rooms\n                                          sum (length (map-nested-elt room '(state events)))\n                                          sum (length (map-nested-elt room '(timeline events)))))\n                            (cl-loop for (_id . room) in invited-rooms\n                                     sum (length (map-nested-elt room '(invite_state events)))))))\n    ;; Append account data events.\n    ;; TODO: Since only one event of each type is allowed in account data (the spec\n    ;; doesn't seem to make this clear, but see\n    ;; ),\n    ;; we should store account-data events in a hash table or alist rather than just a\n    ;; list of events.\n    (cl-callf2 append (cl-coerce account-data-events 'list) (ement-session-account-data session))\n    ;; Process invited and joined rooms.\n    (ement-with-progress-reporter (:when (ement--sync-messages-p session)\n                                         :reporter (\"Ement: Reading events...\" 0 num-events))\n      ;; Left rooms.\n      (mapc (apply-partially #'ement--push-left-room-events session) left-rooms)\n      ;; Invited rooms.\n      (mapc (apply-partially #'ement--push-invite-room-events session) invited-rooms)\n      ;; Joined rooms.\n      (mapc (apply-partially #'ement--push-joined-room-events session) joined-rooms))\n    ;; TODO: Process \"left\" rooms (remove room structs, etc).\n    ;; NOTE: We update the next-batch token before updating any room buffers.  This means\n    ;; that any errors in updating room buffers (like for unexpected event formats that\n    ;; expose a bug) could cause events to not appear in the buffer, but the user could\n    ;; still dismiss the error and start syncing again, and the client could remain\n    ;; usable.  Updating the token after doing everything would be preferable in some\n    ;; ways, but it would mean that an event that exposes a bug would be processed again\n    ;; on every sync, causing the same error each time.  It would seem preferable to\n    ;; maintain at least some usability rather than to keep repeating a broken behavior.\n    (setf (ement-session-next-batch session) next-batch)\n    ;; Run hooks which update buffers, etc.\n    (run-hook-with-args 'ement-sync-callback-hook session)\n    ;; Show sync message if appropriate, and run after-initial-sync-hook.\n    (when (ement--sync-messages-p session)\n      (message (concat \"Ement: Sync done.\"\n                       (unless (ement-session-has-synced-p session)\n                         (run-hook-with-args 'ement-after-initial-sync-hook session)\n                         ;; Show tip after initial sync.\n                         (setf (ement-session-has-synced-p session) t)\n                         \"  Use commands `ement-list-rooms' or `ement-view-room' to view a room.\"))))))\n\n(defun ement--push-invite-room-events (session invited-room)\n  \"Push events for INVITED-ROOM into that room in SESSION.\"\n  ;; TODO: Make ement-session-rooms a hash-table.\n  (ement--push-joined-room-events session invited-room 'invite))\n\n(defun ement--auto-sync (session)\n  \"If `ement-auto-sync' is non-nil, sync SESSION again.\"\n  (when ement-auto-sync\n    (ement--sync session)))\n\n(defun ement--update-room-buffers (session)\n  \"Insert new events into SESSION's rooms which have buffers.\nTo be called in `ement-sync-callback-hook'.\"\n  ;; TODO: Move this to ement-room.el, probably.\n  ;; For now, we primitively iterate over the buffer list to find ones\n  ;; whose mode is `ement-room-mode'.\n  (let* ((buffers (cl-loop for room in (ement-session-rooms session)\n                           for buffer = (map-elt (ement-room-local room) 'buffer)\n                           when (buffer-live-p buffer)\n                           collect buffer)))\n    (dolist (buffer buffers)\n      (with-current-buffer buffer\n        (save-window-excursion\n          ;; NOTE: When the buffer has a window, it must be the selected one\n          ;; while calling event-insertion functions.  I don't know if this is\n          ;; due to a bug in EWOC or if I just misunderstand something, but\n          ;; without doing this, events may be inserted at the wrong place.\n          (when-let ((buffer-window (get-buffer-window buffer)))\n            (select-window buffer-window))\n          (cl-assert ement-room)\n          (when (ement-room-ephemeral ement-room)\n            ;; Ephemeral events.\n            (ement-room--process-events (ement-room-ephemeral ement-room))\n            (setf (ement-room-ephemeral ement-room) nil))\n          (when-let ((new-events (alist-get 'new-events (ement-room-local ement-room))))\n            ;; HACK: Process these events in reverse order, so that later events (like reactions)\n            ;; which refer to earlier events can find them.  (Not sure if still necessary.)\n            (ement-room--process-events (reverse new-events))\n            (setf (alist-get 'new-events (ement-room-local ement-room)) nil))\n          (when-let ((new-events (alist-get 'new-account-data-events (ement-room-local ement-room))))\n            ;; Account data events.  Do this last so, e.g. read markers can refer to message events we've seen.\n            (ement-room--process-events new-events)\n            (setf (alist-get 'new-account-data-events (ement-room-local ement-room)) nil)))))))\n\n(cl-defun ement--push-joined-room-events (session joined-room &optional (status 'join))\n  \"Push events for JOINED-ROOM into that room in SESSION.\nAlso used for left rooms, in which case STATUS should be set to\n`leave'.\"\n  (pcase-let* ((`(,id . ,event-types) joined-room)\n               (id (symbol-name id)) ; Really important that the ID is a STRING!\n               ;; TODO: Make ement-session-rooms a hash-table.\n               (room (or (cl-find-if (lambda (room)\n                                       (equal id (ement-room-id room)))\n                                     (ement-session-rooms session))\n                         (car (push (make-ement-room :id id) (ement-session-rooms session)))))\n               ((map summary state ephemeral timeline\n                     ('invite_state (map ('events invite-state-events)))\n                     ('account_data (map ('events account-data-events)))\n                     ('unread_notifications unread-notifications))\n                event-types)\n               (latest-timestamp))\n    (setf (ement-room-status room) status\n          (ement-room-unread-notifications room) unread-notifications)\n    ;; NOTE: The idea is that, assuming that events in the sync reponse are in\n    ;; chronological order, we push them to the lists in the room slots in that order,\n    ;; leaving the head of each list as the most recent event of that type.  That means\n    ;; that, e.g. the room state events may be searched in order to find, e.g. the most\n    ;; recent room name event.  However, chronological order is not guaranteed, e.g. after\n    ;; loading older messages (the \"retro\" function; this behavior is in development).\n\n    ;; MAYBE: Use queue.el to store the events in a DLL, so they could\n    ;; be accessed from either end.  Could be useful.\n\n    ;; Push the StrippedState events to the room's invite-state.  (These events have no\n    ;; timestamp data.)  We also run the event hook, because for invited rooms, the\n    ;; invite-state events include room name, topic, etc.\n    (cl-loop for event across-ref invite-state-events do\n             (setf event (ement--make-event event))\n             (push event (ement-room-invite-state room))\n             (run-hook-with-args 'ement-event-hook event room session))\n\n    ;; Save room summary.\n    (dolist (parameter '(m.heroes m.joined_member_count m.invited_member_count))\n      (when (alist-get parameter summary)\n        ;; These fields are only included when they change.\n        (setf (alist-get parameter (ement-room-summary room)) (alist-get parameter summary))))\n\n    ;; Update account data.  According to the spec, only one of each event type is\n    ;; supposed to be present in a room's account data, so we store them as an alist keyed\n    ;; on their type.  (NOTE: We don't currently make them into event structs, but maybe\n    ;; we should in the future.)\n    (cl-loop for event across account-data-events\n             for type = (alist-get 'type event)\n             do (setf (alist-get type (ement-room-account-data room) nil nil #'equal) event))\n    ;; But we also need to track just the new events so we can process those in a room\n    ;; buffer (and for some reason, we do make them into structs here, but I don't\n    ;; remember why).  FIXME: Unify this.\n    (cl-callf2 append (mapcar #'ement--make-event account-data-events)\n               (alist-get 'new-account-data-events (ement-room-local room)))\n\n    ;; Save state and timeline events.\n    (cl-macrolet ((push-events\n                   (type accessor)\n                   ;; Push new events of TYPE to room's slot of ACCESSOR, and return the latest timestamp pushed.\n                   `(let ((ts 0))\n                      ;; NOTE: We replace each event in the vector with the\n                      ;; struct, which is used when calling hooks later.\n                      (cl-loop for event across-ref (alist-get 'events ,type)\n                               do (setf event (ement--make-event event))\n                               do (push event (,accessor room))\n                               (when (ement--sync-messages-p session)\n                                 (ement-progress-update))\n                               (when (> (ement-event-origin-server-ts event) ts)\n                                 (setf ts (ement-event-origin-server-ts event))))\n                      ;; One would think that one should use `maximizing' here, but, completely\n                      ;; inexplicably, it sometimes returns nil, even when every single value it's comparing\n                      ;; is a number.  It's absolutely bizarre, but I have to do the equivalent manually.\n                      ts)))\n      ;; FIXME: This is a bit convoluted and hacky now.  Refactor it.\n      (setf latest-timestamp\n            (max (push-events state ement-room-state)\n                 (push-events timeline ement-room-timeline)))\n      ;; NOTE: We also append the new events to the new-events list in the room's local\n      ;; slot, which is used by `ement--update-room-buffers' to insert only new events.\n      ;; FIXME: Does this also need to be done for invite-state events?\n      (cl-callf2 append (cl-coerce (alist-get 'events timeline) 'list)\n                 (alist-get 'new-events (ement-room-local room)))\n      ;; Update room's latest-timestamp slot.\n      (when (> latest-timestamp (or (ement-room-latest-ts room) 0))\n        (setf (ement-room-latest-ts room) latest-timestamp))\n      (unless (ement-session-has-synced-p session)\n        ;; Only set this token on initial sync, otherwise it would\n        ;; overwrite earlier tokens from loading earlier messages.\n        (setf (ement-room-prev-batch room) (alist-get 'prev_batch timeline))))\n    ;; Run event hook for state and timeline events.\n    (cl-loop for event across (alist-get 'events state)\n             do (run-hook-with-args 'ement-event-hook event room session)\n             (when (ement--sync-messages-p session)\n               (ement-progress-update)))\n    (cl-loop for event across (alist-get 'events timeline)\n             do (run-hook-with-args 'ement-event-hook event room session)\n             (when (ement--sync-messages-p session)\n               (ement-progress-update)))\n    ;; Ephemeral events (do this after state and timeline hooks, so those events will be\n    ;; in the hash tables).\n    (cl-loop for event across (alist-get 'events ephemeral)\n             for event-struct = (ement--make-event event)\n             do (push event-struct (ement-room-ephemeral room))\n             (ement--process-event event-struct room session))\n    (when (ement-session-has-synced-p session)\n      ;; NOTE: We don't fill gaps in \"limited\" requests on initial\n      ;; sync, only in subsequent syncs, e.g. after the system has\n      ;; slept and awakened.\n      ;; NOTE: When not limited, the read value is `:json-false', so\n      ;; we must explicitly compare to t.\n      (when (eq t (alist-get 'limited timeline))\n\t;; Timeline was limited: start filling gap.  We start the\n\t;; gap-filling, retrieving up to the session's current\n\t;; next-batch token (this function is not called when retrieving\n\t;; older messages, so the session's next-batch token is only\n\t;; evaluated once, when this chain begins, and then that token\n\t;; is passed to repeated calls to `ement-room-retro-to-token'\n\t;; until the gap is filled).\n\t(ement-room-retro-to-token room session (alist-get 'prev_batch timeline)\n\t\t\t\t   (ement-session-next-batch session))))))\n\n(defun ement--push-left-room-events (session left-room)\n  \"Push events for LEFT-ROOM into that room in SESSION.\"\n  (ement--push-joined-room-events session left-room 'leave))\n\n(defun ement--make-event (event)\n  \"Return `ement-event' struct for raw EVENT list.\nAdds sender to `ement-users' when necessary.\"\n  (pcase-let* (((map content type unsigned redacts\n                     ('event_id id) ('origin_server_ts ts)\n                     ('sender sender-id) ('state_key state-key))\n                event)\n               (sender (or (gethash sender-id ement-users)\n                           (puthash sender-id (make-ement-user :id sender-id)\n                                    ement-users))))\n    ;; MAYBE: Handle other keys in the event, such as \"room_id\" in \"invite\" events.\n    (make-ement-event :id id :sender sender :type type :content content :state-key state-key\n                      :origin-server-ts ts :unsigned unsigned\n                      ;; Since very few events will be redactions and have this key, we\n                      ;; record it in the local slot alist rather than as another slot on\n                      ;; the struct.\n                      :local (when redacts\n                               (ement-alist 'redacts redacts)))))\n\n(defun ement--put-event (event _room session)\n  \"Put EVENT on SESSION's events table.\"\n  (puthash (ement-event-id event) event (ement-session-events session)))\n\n;; FIXME: These functions probably need to compare timestamps to\n;; ensure that older events that are inserted at the head of the\n;; events lists aren't used instead of newer ones.\n\n;; TODO: These two functions should be folded into event handlers.\n\n;;;;; Reading/writing sessions\n\n(defun ement--read-sessions ()\n  \"Return saved sessions alist read from disk.\nReturns nil if unable to read `ement-sessions-file'.\"\n  (cl-labels ((plist-to-session\n               (plist) (pcase-let* (((map (:user user-data) (:server server-data)\n                                          (:token token) (:transaction-id transaction-id))\n                                     plist)\n                                    (user (apply #'make-ement-user user-data))\n                                    (server (apply #'make-ement-server server-data))\n                                    (session (make-ement-session :user user :server server\n                                                                 :token token :transaction-id transaction-id)))\n                         (setf (ement-session-events session) (make-hash-table :test #'equal))\n                         session)))\n    (when (file-exists-p ement-sessions-file)\n      (pcase-let* ((read-circle t)\n                   (sessions (with-temp-buffer\n                               (insert-file-contents ement-sessions-file)\n                               (read (current-buffer)))))\n        (prog1\n            (cl-loop for (id . plist) in sessions\n                     collect (cons id (plist-to-session plist)))\n          (message \"Ement: Read sessions.\"))))))\n\n(defun ement--write-sessions (sessions-alist)\n  \"Write SESSIONS-ALIST to disk.\"\n  ;; We only record the slots we need.  We record them as a plist\n  ;; so that changes to the struct definition don't matter.\n  ;; NOTE: If we ever persist more session data (like room data, so we\n  ;; could avoid doing an initial sync next time), we should limit the\n  ;; amount of session data saved (e.g. room history could grow\n  ;; forever on-disk, which probably isn't what we want).\n\n  ;; NOTE: This writes all current sessions, even if there are multiple active ones and only one\n  ;; is being disconnected.  That's probably okay, but it might be something to keep in mind.\n  (cl-labels ((session-plist\n               (session) (pcase-let* (((cl-struct ement-session user server token transaction-id) session)\n                                      ((cl-struct ement-user (id user-id) username) user)\n                                      ((cl-struct ement-server (name server-name) uri-prefix) server))\n                           (list :user (list :id user-id\n                                             :username username)\n                                 :server (list :name server-name\n                                               :uri-prefix uri-prefix)\n                                 :token token\n                                 :transaction-id transaction-id))))\n    (message \"Ement: Writing sessions...\")\n    (with-temp-file ement-sessions-file\n      (pcase-let* ((print-level nil)\n                   (print-length nil)\n                   ;; Very important to use `print-circle', although it doesn't\n                   ;; solve everything.  Writing/reading Lisp data can be tricky...\n                   (print-circle t)\n                   (sessions-alist-plist (cl-loop for (id . session) in sessions-alist\n                                                  collect (cons id (session-plist session)))))\n        (prin1 sessions-alist-plist (current-buffer))))\n    ;; Ensure permissions are safe.\n    (chmod ement-sessions-file #o600)))\n\n(defun ement--kill-emacs-hook ()\n  \"Function to be added to `kill-emacs-hook'.\nWrites Ement session to disk when enabled.\"\n  (ignore-errors\n    ;; To avoid interfering with Emacs' exit, We must be careful that\n    ;; this function handles errors, so just ignore any.\n    (when (and ement-save-sessions\n               ement-sessions)\n      (ement--write-sessions ement-sessions))))\n\n;;;;; Event handlers\n\n(defvar ement-event-handlers nil\n  \"Alist mapping event types to functions which process an event of each type.\nEach function is called with three arguments: the event, the\nroom, and the session.  These handlers are run regardless of\nwhether a room has a live buffer.\")\n\n(defun ement--process-event (event room session)\n  \"Process EVENT for ROOM in SESSION.\nUses handlers defined in `ement-event-handlers'.  If no handler\nis defined for EVENT's type, does nothing and returns nil.  Any\nerrors signaled during processing are demoted in order to prevent\nunexpected errors from arresting event processing and syncing.\"\n  (when-let ((handler (alist-get (ement-event-type event) ement-event-handlers nil nil #'equal)))\n    ;; We demote any errors that happen while processing events, because it's possible for\n    ;; events to be malformed in unexpected ways, and that could cause an error, which\n    ;; would stop processing of other events and prevent further syncing.  See,\n    ;; e.g. .\n    (with-demoted-errors \"Ement (ement--process-event): Error processing event: %S\"\n      (funcall handler event room session))))\n\n(defmacro ement-defevent (type &rest body)\n  \"Define an event handling function for events of TYPE, a string.\nAround the BODY, the variable `event' is bound to the event being\nprocessed, `room' to the room struct in which the event occurred,\nand `session' to the session.  Adds function to\n`ement-event-handlers', which see.\"\n  (declare (indent defun))\n  `(setf (alist-get ,type ement-event-handlers nil nil #'string=)\n         (lambda (event room session)\n           ,(concat \"`ement-' handler function for \" type \" events.\")\n           ,@body)))\n\n;; I love how Lisp macros make it so easy and concise to define these\n;; event handlers!\n\n(ement-defevent \"m.room.avatar\"\n  (when ement-room-avatars\n    ;; If room avatars are disabled, we don't download avatars at all.  This\n    ;; means that, if a user has them disabled and then reenables them, they will\n    ;; likely need to reconnect to cause them to be displayed in most rooms.\n    (if-let ((url (alist-get 'url (ement-event-content event))))\n        (plz-run\n         (plz-queue ement-images-queue\n           'get (ement--mxc-to-url url session) :as 'binary :noquery t\n           :then (lambda (data)\n                   (when ement-room-avatars\n                     ;; MAYBE: Store the raw image data instead of using create-image here.\n                     (let ((image (create-image data nil 'data-p\n                                                :ascent 'center\n                                                :max-width ement-room-avatar-max-width\n                                                :max-height ement-room-avatar-max-height)))\n                       (if (not image)\n                           (progn\n                             (display-warning 'ement (format \"Room avatar seems unreadable:  ROOM-ID:%S  AVATAR-URL:%S\"\n                                                             (ement-room-id room) (ement--mxc-to-url url session)))\n                             (setf (ement-room-avatar room) nil\n                                   (alist-get 'room-list-avatar (ement-room-local room)) nil))\n                         (when (fboundp 'imagemagick-types)\n                           ;; Only do this when ImageMagick is supported.\n                           ;; FIXME: When requiring Emacs 27+, remove this (I guess?).\n                           (setf (image-property image :type) 'imagemagick))\n                         ;; We set the room-avatar slot to a propertized string that\n                         ;; displays as the image.  This seems the most convenient thing to\n                         ;; do.  We also unset the cached room-list-avatar so it can be\n                         ;; remade.\n                         (setf (ement-room-avatar room) (propertize \" \" 'display image)\n                               (alist-get 'room-list-avatar (ement-room-local room)) nil)))))))\n      ;; Unset avatar.\n      (setf (ement-room-avatar room) nil\n            (alist-get 'room-list-avatar (ement-room-local room)) nil))))\n\n(ement-defevent \"m.room.create\"\n  (ignore session)\n  (pcase-let* (((cl-struct ement-event (content (map type))) event))\n    (when type\n      (setf (ement-room-type room) type))))\n\n(ement-defevent \"m.room.member\"\n  \"Put/update member on `ement-users' and room's members table.\"\n  (ignore session)\n  (pcase-let* (((cl-struct ement-room members) room)\n               ((cl-struct ement-event state-key\n                           (content (map displayname membership\n                                         ('avatar_url avatar-url))))\n                event)\n               (user (or (gethash state-key ement-users)\n                         (puthash state-key\n                                  (make-ement-user :id state-key :avatar-url avatar-url\n                                                   ;; NOTE: The spec doesn't seem to say whether the\n                                                   ;; displayname in the member event applies only to the\n                                                   ;; room or is for the user generally, so we'll save it\n                                                   ;; in the struct anyway.\n                                                   :displayname displayname)\n                                  ement-users))))\n    (pcase membership\n      (\"join\"\n       (puthash state-key user members)\n       (puthash user displayname (ement-room-displaynames room)))\n      (_ (remhash state-key members)\n         (remhash user (ement-room-displaynames room))))))\n\n(ement-defevent \"m.room.name\"\n  (ignore session)\n  (pcase-let* (((cl-struct ement-event (content (map name))) event))\n    (when name\n      ;; Recalculate room name and cache in slot.\n      (setf (ement-room-display-name room) (ement--room-display-name room)))))\n\n(ement-defevent \"m.room.topic\"\n  (ignore session)\n  (pcase-let* (((cl-struct ement-event (content (map topic))) event))\n    (when topic\n      (setf (ement-room-topic room) topic))))\n\n(ement-defevent \"m.receipt\"\n  (ignore session)\n  (pcase-let (((cl-struct ement-event content) event)\n              ((cl-struct ement-room (receipts room-receipts)) room))\n    (cl-loop for (event-id . receipts) in content\n             do (cl-loop for (user-id . receipt) in (alist-get 'm.read receipts)\n                         ;; Users may not have been \"seen\" yet, so although we'd\n                         ;; prefer to key on the user struct, we key on the user ID.\n                         ;; Same for events, unfortunately.\n                         ;; NOTE: The JSON map keys are converted to symbols by `json-read'.\n                         ;; MAYBE: (Should we keep them that way?  It would use less memory, I guess.)\n                         do (puthash (symbol-name user-id)\n                                     (cons (symbol-name event-id) (alist-get 'ts receipt))\n                                     room-receipts)))))\n\n(ement-defevent \"m.space.child\"\n  ;; SPEC: v1.2/11.35.\n  (pcase-let* ((space-room room)\n               ((cl-struct ement-session rooms) session)\n               ((cl-struct ement-room (id parent-room-id)) space-room)\n               ((cl-struct ement-event (state-key child-room-id) (content (map via))) event)\n               (child-room (cl-find child-room-id rooms :key #'ement-room-id :test #'equal)))\n    (if via\n        ;; Child being declared: add it.\n        (progn\n          (cl-pushnew child-room-id (alist-get 'children (ement-room-local space-room)) :test #'equal)\n          (when child-room\n            ;; The user is also in the child room: link the parent space-room in it.\n            ;; FIXME: On initial sync, if the child room hasn't been processed yet, this will fail.\n            (cl-pushnew parent-room-id (alist-get 'parents (ement-room-local child-room)) :test #'equal)))\n      ;; Child being disowned: remove it.\n      (setf (alist-get 'children (ement-room-local space-room))\n            (delete child-room-id (alist-get 'children (ement-room-local space-room))))\n      (when child-room\n        ;; The user is also in the child room: unlink the parent space-room in it.\n        (setf (alist-get 'parents (ement-room-local child-room))\n              (delete parent-room-id (alist-get 'parents (ement-room-local child-room))))))))\n\n(ement-defevent \"m.room.canonical_alias\"\n  (ignore session)\n  (pcase-let (((cl-struct ement-event (content (map alias))) event))\n    (setf (ement-room-canonical-alias room) alias)))\n\n(defun ement--link-children (session)\n  \"Link child rooms in SESSION.\nTo be called after initial sync.\"\n  ;; On initial sync, when processing m.space.child events, the child rooms may not have\n  ;; been processed yet, so we link them again here.\n  (pcase-let (((cl-struct ement-session rooms) session))\n    (dolist (room rooms)\n      (pcase-let (((cl-struct ement-room (id parent-id) (local (map children))) room))\n        (when children\n          (dolist (child-id children)\n            (when-let ((child-room (cl-find child-id rooms :key #'ement-room-id :test #'equal)))\n              (cl-pushnew parent-id (alist-get 'parents (ement-room-local child-room)) :test #'equal))))))))\n\n;;;; Footer\n\n(provide 'ement)\n\n;;; ement.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"ement.info","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":1543971,"end":1544005},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1544005},"to":{"change":3,"start":1510057,"end":1510057},"introduced_by":3}],"inode":{"change":3,"pos":1510057}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1510057},"to":{"change":3,"start":1510058,"end":1543970},"introduced_by":3}],"inode":{"change":3,"pos":1510057}},"content":[{"Del":"This is dockAviIV.info, produced by makeinfo version 6.7 from\nement.texi.\n\nINFO-DIR-SECTION Emacs\nSTART-INFO-DIR-ENTRY\n* Ement: (ement).       Matrix client for Emacs.\nEND-INFO-DIR-ENTRY\n\n\u001f\nFile: dockAviIV.info,  Node: Top,  Next: Installation,  Up: (dir)\n\nEment.el\n********\n\nhttps://elpa.gnu.org/packages/ement.svg\n(https://elpa.gnu.org/packages/ement.html)\n\n   Ement.el is a Matrix client for Emacs.  It aims to be simple, fast,\nfeatureful, and reliable.\n\n   Feel free to join us in the chat room:\nhttps://img.shields.io/matrix/ement.el:matrix.org.svg?label=%23ement.el:matrix.org\n(https://matrix.to/#/#ement.el:matrix.org)\n\n* Menu:\n\n* Installation::\n* Usage::\n* Rationale::\n* Changelog::\n* Development::\n* License::\n\n— The Detailed Node Listing —\n\nInstallation\n\n* GNU ELPA::\n* GNU Guix::\n* Debian::\n* Git master::\n* Manual::\n\nUsage\n\n* Bindings::\n* Tips::\n* Encrypted room support through Pantalaimon::\n\nBindings\n\n* Room buffers::\n* Room list buffer::\n* Directory buffers::\n* Mentions/notifications buffers::\n\nTips\n\n* Displaying symbols and emojis::\n\nChangelog\n\n* 0.9.2: 092.\n* 0.9.1: 091.\n* 0.9: 09.\n* 0.8.3: 083.\n* 0.8.2: 082.\n* 0.8.1: 081.\n* 0.8: 08.\n* 0.7: 07.\n* 0.6: 06.\n* 0.5.2: 052.\n* 0.5.1: 051.\n* 0.5: 05.\n* 0.4.1: 041.\n* 0.4: 04.\n* 0.3.1: 031.\n* 0.3: 03.\n* 0.2.1: 021.\n* 0.2: 02.\n* 0.1.4: 014.\n* 0.1.3: 013.\n* 0.1.2: 012.\n* 0.1.1: 011.\n* 0.1: 01.\n\nDevelopment\n\n* Copyright Assignment::\n* Matrix spec in Org format::\n\n\n\u001f\nFile: dockAviIV.info,  Node: Installation,  Next: Usage,  Prev: Top,  Up: Top\n\n1 Installation\n**************\n\n* Menu:\n\n* GNU ELPA::\n* GNU Guix::\n* Debian::\n* Git master::\n* Manual::\n\n\u001f\nFile: dockAviIV.info,  Node: GNU ELPA,  Next: GNU Guix,  Up: Installation\n\n1.1 GNU ELPA\n============\n\nEment.el is published in GNU ELPA (http://elpa.gnu.org/), so it may be\ninstalled in Emacs with the command ‘M-x package-install RET ement RET’.\nThis is the recommended way to install Ement.el, as it will install the\ncurrent stable release.\n\n\u001f\nFile: dockAviIV.info,  Node: GNU Guix,  Next: Debian,  Prev: GNU ELPA,  Up: Installation\n\n1.2 GNU Guix\n============\n\nEment.el is also available in GNU Guix (https://guix.gnu.org/) as\n‘emacs-ement’.\n\n\u001f\nFile: dockAviIV.info,  Node: Debian,  Next: Git master,  Prev: GNU Guix,  Up: Installation\n\n1.3 Debian\n==========\n\nEment.el is also available in Debian as elpa-ement\n(https://packages.debian.org/elpa-ement).\n\n\u001f\nFile: dockAviIV.info,  Node: Git master,  Next: Manual,  Prev: Debian,  Up: Installation\n\n1.4 Git master\n==============\n\nThe ‘master’ branch of the Git repository is intended to be usable at\nall times; only minor bugs are expected to be found in it before a new\nstable release is made.  To install from this, it is recommended to use\nquelpa-use-package (https://github.com/quelpa/quelpa-use-package), like\nthis:\n\n     ;; Install and load `quelpa-use-package'.\n     (package-install 'quelpa-use-package)\n     (require 'quelpa-use-package)\n\n     ;; Install Ement.\n     (use-package ement\n       :quelpa (ement :fetcher github :repo \"alphapapa/ement.el\"))\n\n   One might also use systems like Straight\n(https://github.com/radian-software/straight.el) (which is also used by\nDOOM (https://github.com/doomemacs/doomemacs)) to install from Git, but\nthe author cannot offer support for them.\n\n\u001f\nFile: dockAviIV.info,  Node: Manual,  Prev: Git master,  Up: Installation\n\n1.5 Manual\n==========\n\nEment.el is intended to be installed with Emacs’s package system, which\nwill ensure that the required autoloads are generated, etc.  If you\nchoose to install it manually, you’re on your own.\n\n\u001f\nFile: dockAviIV.info,  Node: Usage,  Next: Rationale,  Prev: Installation,  Up: Top\n\n2 Usage\n*******\n\n   • • • \n  1. Call command ‘ement-connect’ to connect.  Multiple sessions are\n     supported, so you may call the command again to connect to another\n     account.\n  2. Wait for initial sync to complete (which can take a few\n     moments–initial sync JSON requests can be large).\n  3. Use these commands (room-related commands may be called with\n     universal prefix to prompt for the room):\n        • ‘ement-list-rooms’ to view the list of joined rooms.\n        • ‘ement-view-room’ to view a room’s buffer, selected with\n          completion.\n        • ‘ement-create-room’ to create a new room.\n        • ‘ement-create-space’ to create a space.\n        • ‘ement-invite-user’ to invite a user to a room.\n        • ‘ement-join-room’ to join a room.\n        • ‘ement-leave-room’ to leave a room.\n        • ‘ement-forget-room’ to forget a room.\n        • ‘ement-tag-room’ to toggle a tag on a room (including\n          favorite/low-priority status).\n        • ‘ement-list-members’ to list members in a room.\n        • ‘ement-send-direct-message’ to send a direct message to a user\n          (in an existing direct room, or creating a new one\n          automatically).\n        • ‘ement-room-edit-message’ to edit a message at point.\n        • ‘ement-room-send-file’ to send a file.\n        • ‘ement-room-send-image’ to send an image.\n        • ‘ement-room-set-topic’ to set a room’s topic.\n        • ‘ement-room-occur’ to search in a room’s known events.\n        • ‘ement-room-override-name’ to override a room’s display name.\n        • ‘ement-ignore-user’ to ignore a user (or with interactive\n          prefix, un-ignore).\n        • ‘ement-room-set-message-format’ to set a room’s message format\n          buffer-locally.\n        • ‘ement-room-toggle-space’ to toggle a room’s membership in a\n          space (a way to group rooms in Matrix).\n        • ‘ement-directory’ to view a room directory.\n        • ‘ement-directory-search’ to search a room directory.\n  4. Use these special buffers to see events from multiple rooms (you\n     can also reply to messages from these buffers!):\n        • See all new events that mention you in the ‘*Ement Mentions*’\n          buffer.\n        • See all new events in rooms that have open buffers in the\n          ‘*Ement Notifications*’ buffer.\n\n* Menu:\n\n* Bindings::\n* Tips::\n* Encrypted room support through Pantalaimon::\n\n\u001f\nFile: dockAviIV.info,  Node: Bindings,  Next: Tips,  Up: Usage\n\n2.1 Bindings\n============\n\nThese bindings are common to all of the following buffer types:\n\n   • Switch to a room buffer: ‘M-g M-r’\n   • Switch to the room list buffer: ‘M-g M-l’\n   • Switch to the mentions buffer: ‘M-g M-m’\n   • Switch to the notifications buffer: ‘M-g M-n’\n\n* Menu:\n\n* Room buffers::\n* Room list buffer::\n* Directory buffers::\n* Mentions/notifications buffers::\n\n\u001f\nFile: dockAviIV.info,  Node: Room buffers,  Next: Room list buffer,  Up: Bindings\n\n2.1.1 Room buffers\n------------------\n\n   • Show command menu: ‘?’\n\n   *Movement*\n\n   • Next event: ‘TAB’\n   • Previous event: ‘’\n   • Scroll up and mark read: ‘SPC’\n   • Scroll down: ‘S-SPC’\n   • Jump to fully-read marker: ‘M-SPC’\n   • Load older messages: at top of buffer, scroll contents up (i.e.\n     ‘S-SPC’, ‘M-v’ or ‘mwheel-scroll’)\n\n   *Switching*\n\n   • List rooms: ‘M-g M-l’\n   • Switch to other room: ‘M-g M-r’\n   • Switch to mentions buffer: ‘M-g M-m’\n   • Switch to notifications buffer: ‘M-g M-n’\n   • Quit window: ‘q’\n\n   *Messages*\n\n   • Write message: ‘RET’\n   • Write reply to event at point (when region is active, only quote\n     marked text) : ‘S-RET’\n   • Compose message in buffer: ‘M-RET’ (while writing in minibuffer:\n     ‘C-c ')’ (Use command ‘ement-room-compose-org’ to activate Org mode\n     in the compose buffer.)\n   • Edit message: ‘’\n   • Delete message: ‘C-k’\n   • Send reaction to event at point, or send same reaction at point: ‘s\n     r’\n   • Send emote: ‘s e’\n   • Send file: ‘s f’\n   • Send image: ‘s i’\n   • View event source: ‘v’\n   • Complete members and rooms at point: ‘C-M-i’ (standard\n     ‘completion-at-point’ command).  (Type an ‘@’ prefix for a member\n     mention, a ‘#’ prefix for a room alias, or a ‘!’ prefix for a room\n     ID.)\n\n   *Images*\n\n   • Toggle scale of image (between fit-to-window and thumbnail):\n     ‘mouse-1’\n   • Show image in new buffer at full size: ‘double-mouse-1’\n\n   *Users*\n\n   • Send direct message: ‘u RET’\n   • Invite user: ‘u i’\n   • Ignore user: ‘u I’\n\n   *Room*\n\n   • Occur search in room: ‘M-s o’\n   • List members: ‘r m’\n   • Set topic: ‘r t’\n   • Set message format: ‘r f’\n   • Set notification rules: ‘r n’\n   • Override display name: ‘r N’\n   • Tag/untag room: ‘r T’\n\n   *Room membership*\n\n   • Create room: ‘R c’\n   • Join room: ‘R j’\n   • Leave room: ‘R l’\n   • Forget room: ‘R F’\n   • Toggle room’s spaces: ‘R s’\n\n   *Other*\n\n   • Sync new messages (not necessary if auto sync is enabled; with\n     prefix to force new sync): ‘g’\n\n\u001f\nFile: dockAviIV.info,  Node: Room list buffer,  Next: Directory buffers,  Prev: Room buffers,  Up: Bindings\n\n2.1.2 Room list buffer\n----------------------\n\n   • Show buffer of room at point: ‘RET’\n   • Show buffer of next unread room: ‘SPC’\n   • Move between room names: ‘TAB’ / ‘’\n\n   • Kill room’s buffer: ‘k’\n   • Toggle room’s membership in a space: ‘s’\n\n\u001f\nFile: dockAviIV.info,  Node: Directory buffers,  Next: Mentions/notifications buffers,  Prev: Room list buffer,  Up: Bindings\n\n2.1.3 Directory buffers\n-----------------------\n\n   • View/join a room: ‘RET’ / ‘mouse-1’\n   • Load next batch of rooms: ‘+’\n\n\u001f\nFile: dockAviIV.info,  Node: Mentions/notifications buffers,  Prev: Directory buffers,  Up: Bindings\n\n2.1.4 Mentions/notifications buffers\n------------------------------------\n\n   • Move between events: ‘TAB’ / ‘’\n   • Go to event at point in its room buffer: ‘RET’\n   • Write reply to event at point (shows the event in its room while\n     writing) : ‘S-RET’\n\n\u001f\nFile: dockAviIV.info,  Node: Tips,  Next: Encrypted room support through Pantalaimon,  Prev: Bindings,  Up: Usage\n\n2.2 Tips\n========\n\n   • Desktop notifications are enabled by default for events that\n     mention the local user.  They can also be shown for all events in\n     rooms with open buffers.\n   • Send messages in Org mode format by customizing the option\n     ‘ement-room-send-message-filter’ (which enables Org format by\n     default), or by calling ‘ement-room-compose-org’ in a compose\n     buffer (which enables it for a single message).  Then Org-formatted\n     messages are automatically converted and sent as HTML-formatted\n     messages (with the Org syntax as the plain-text fallback).  You can\n     send syntax such as:\n        • Bold, italic, underline, strikethrough\n        • Links\n        • Tables\n        • Source blocks (including results with ‘:exports both’)\n        • Footnotes (okay, that might be pushing it, but you can!)\n        • And, generally, anything that Org can export to HTML\n   • Starting in the room list buffer, by pressing ‘SPC’ repeatedly, you\n     can cycle through and read all rooms with unread buffers.  (If a\n     room doesn’t have a buffer, it will not be included.)\n   • Room buffers and the room-list buffer can be bookmarked in Emacs,\n     i.e.  using ‘C-x r m’.  This is especially useful with Burly\n     (https://github.com/alphapapa/burly.el): you can arrange an Emacs\n     frame with several room buffers displayed at once, use\n     ‘burly-bookmark-windows’ to bookmark the layout, and then you can\n     restore that layout and all of the room buffers by opening the\n     bookmark, rather than having to manually arrange them every time\n     you start Emacs or change the window configuration.\n   • Images and other files can be uploaded to rooms using\n     drag-and-drop.\n   • Mention members by typing a ‘@’ followed by their displayname or\n     Matrix ID.  (Members’ names and rooms’ aliases/IDs may be completed\n     with ‘completion-at-point’ commands.)\n   • You can customize settings in the ‘ement’ group.\n        • *Note:* ‘setq’ should not be used for certain options, because\n          it will not call the associated setter function.  Users who\n          have an aversion to the customization system may experience\n          problems.\n\n* Menu:\n\n* Displaying symbols and emojis::\n\n\u001f\nFile: dockAviIV.info,  Node: Displaying symbols and emojis,  Up: Tips\n\n2.2.1 Displaying symbols and emojis\n-----------------------------------\n\nEmacs may not display certain symbols and emojis well by default.  Based\non this question and answer\n(https://emacs.stackexchange.com/questions/62049/override-the-default-font-for-emoji-characters),\nyou may find that the simplest way to fix this is to install an\nappropriate font, like Noto Emoji\n(https://www.google.com/get/noto/#emoji-zsye), and then use this Elisp\ncode:\n\n     (setf use-default-font-for-symbols nil)\n     (set-fontset-font t 'unicode \"Noto Emoji\" nil 'append)\n\n\u001f\nFile: dockAviIV.info,  Node: Encrypted room support through Pantalaimon,  Prev: Tips,  Up: Usage\n\n2.3 Encrypted room support through Pantalaimon\n==============================================\n\nEment.el doesn’t support encrypted rooms natively, but it can be used\ntransparently with the E2EE-aware reverse proxy daemon Pantalaimon\n(https://github.com/matrix-org/pantalaimon/).  After configuring it\naccording to its documentation, call ‘ement-connect’ with the\nappropriate hostname and port, like:\n\n     (ement-connect :uri-prefix \"http://localhost:8009\")\n\n\u001f\nFile: dockAviIV.info,  Node: Rationale,  Next: Changelog,  Prev: Usage,  Up: Top\n\n3 Rationale\n***********\n\nWhy write a new Emacs Matrix client when there is already\nmatrix-client.el (https://github.com/alphapapa/matrix-client.el), by the\nsame author, no less?  A few reasons:\n\n   • ‘matrix-client’ uses an older version of the Matrix spec, r0.3.0,\n     with a few elements of r0.4.0 grafted in.  Bringing it up to date\n     with the current version of the spec, r0.6.1, would be more work\n     than to begin with the current version.  Ement.el targets r0.6.1\n     from the beginning.\n   • ‘matrix-client’ does not use Matrix’s lazy-loading feature (which\n     was added to the specification later), so initial sync requests can\n     take a long time for the server to process and can be large\n     (sometimes tens of megabytes of JSON for the client to process!).\n     Ement.el uses lazy-loading, which significantly improves\n     performance.\n   • ‘matrix-client’ automatically makes buffers for every room a user\n     has joined, even if the user doesn’t currently want to watch a\n     room.  Ement.el opens room buffers on-demand, improving performance\n     by not having to insert events into buffers for rooms the user\n     isn’t watching.\n   • ‘matrix-client’ was developed without the intention of publishing\n     it to, e.g.  MELPA or ELPA.  It has several dependencies, and its\n     code does not always install or compile cleanly due to\n     macro-expansion issues (apparently depending on the user’s Emacs\n     config).  Ement.el is designed to have minimal dependencies outside\n     of Emacs (currently only one, ‘plz’, which could be imported into\n     the project), and every file is linted and compiles cleanly using\n     makem.sh (https://github.com/alphapapa/makem.sh).\n   • ‘matrix-client’ uses EIEIO, probably unnecessarily, since few, if\n     any, of the benefits of EIEIO are realized in it.  Ement.el uses\n     structs instead.\n   • ‘matrix-client’ uses bespoke code for inserting messages into\n     buffers, which works pretty well, but has a few minor bugs which\n     are difficult to track down.  Ement.el uses Emacs’s built-in (and\n     perhaps little-known) ‘ewoc’ library, which makes it much simpler\n     and more reliable to insert and update messages in buffers, and\n     enables the development of advanced UI features more easily.\n   • ‘matrix-client’ was, to a certain extent, designed to imitate other\n     messaging apps.  The result is, at least when used with the\n     ‘matrix-client-frame’ command, fairly pleasing to use, but isn’t\n     especially \"Emacsy.\"  Ement.el is intended to better fit into\n     Emacs’s paradigms.\n   • ‘matrix-client’’s long name makes for long symbol names, which\n     makes for tedious, verbose code.  ‘ement’ is easy to type and makes\n     for concise, readable code.\n   • The author has learned much since writing ‘matrix-client’ and hopes\n     to write simpler, more readable, more maintainable code in\n     Ement.el.  It’s hoped that this will enable others to contribute\n     more easily.\n\n   Note that, while ‘matrix-client’ remains usable, and probably will\nfor some time to come, Ement.el has now surpassed it in every way.  The\nonly reason to choose ‘matrix-client’ instead is if one is using an\nolder version of Emacs that isn’t supported by Ement.el.\n\n\u001f\nFile: dockAviIV.info,  Node: Changelog,  Next: Development,  Prev: Rationale,  Up: Top\n\n4 Changelog\n***********\n\n* Menu:\n\n* 0.9.2: 092.\n* 0.9.1: 091.\n* 0.9: 09.\n* 0.8.3: 083.\n* 0.8.2: 082.\n* 0.8.1: 081.\n* 0.8: 08.\n* 0.7: 07.\n* 0.6: 06.\n* 0.5.2: 052.\n* 0.5.1: 051.\n* 0.5: 05.\n* 0.4.1: 041.\n* 0.4: 04.\n* 0.3.1: 031.\n* 0.3: 03.\n* 0.2.1: 021.\n* 0.2: 02.\n* 0.1.4: 014.\n* 0.1.3: 013.\n* 0.1.2: 012.\n* 0.1.1: 011.\n* 0.1: 01.\n\n\u001f\nFile: dockAviIV.info,  Node: 092,  Next: 091,  Up: Changelog\n\n4.1 0.9.2\n=========\n\n*Fixes*\n   • Restore position in room list when refreshing.\n   • Completion in minibuffer.\n\n\u001f\nFile: dockAviIV.info,  Node: 091,  Next: 09,  Prev: 092,  Up: Changelog\n\n4.2 0.9.1\n=========\n\n*Fixes*\n   • Error in ‘ement-room-list’ command upon initial sync.\n\n\u001f\nFile: dockAviIV.info,  Node: 09,  Next: 083,  Prev: 091,  Up: Changelog\n\n4.3 0.9\n=======\n\n*Additions*\n\n   • Option ‘ement-room-timestamp-header-align’ controls how timestamp\n     headers are aligned in room buffers.\n   • Option ‘ement-room-view-hook’ runs functions when ‘ement-room-view’\n     is called.  (By default, it refreshes the room list buffer.)\n   • In the room list, middle-clicking a room which has a buffer closes\n     its buffer.\n   • Basic support for video events.  (Thanks to Arto Jantunen\n     (https://github.com/viiru-).)\n\n   *Changes*\n\n   • Using new option ‘ement-room-timestamp-header-align’, timestamp\n     headers default to right-aligned.  (With default settings, this\n     keeps them near message timestamps and makes for a cleaner\n     appearance.)\n\n   *Fixes*\n\n   • Recognition of certain MXID or displayname forms in outgoing\n     messages when linkifying (aka \"pilling\") them.\n   • Unreadable room avatar images no longer cause errors.  (Fixes #147\n     (https://github.com/alphapapa/ement.el/issues/147).  Thanks to\n     @jgarte (https://github.com/jgarte) for reporting.)\n   • Don’t error in ‘ement-room-list’ when no rooms are joined.  (Fixes\n     #123 (https://github.com/alphapapa/ement.el/issues/123).  Thanks to\n     @Kabouik (https://github.com/Kabouik) and Omar Antolín Camarena\n     (https://github.com/oantolin) for reporting.)\n   • Enable member/room completion in compose buffers.  (Fixes #115\n     (https://github.com/alphapapa/ement.el/issues/115).  Thanks to\n     Thanks to Justus Piater (https://github.com/piater) and Caleb Chase\n     (https://github.com/chasecaleb) for reporting.)\n\n\u001f\nFile: dockAviIV.info,  Node: 083,  Next: 082,  Prev: 09,  Up: Changelog\n\n4.4 0.8.3\n=========\n\n*Fixes*\n\n   • Avoid use of ‘pcase’’s ‘(map :KEYWORD)’ form.  (This can cause a\n     broken installation on older versions of Emacs that have an older\n     version of the ‘map’ library loaded, such as Emacs 27.2 included in\n     Debian 11.  Since there’s no way to force Emacs to actually load\n     the version of ‘map’ required by this package before installing it\n     (which would naturally happen upon restarting Emacs), we can only\n     avoid using such forms while these versions of Emacs are widely\n     used.)\n\n\u001f\nFile: dockAviIV.info,  Node: 082,  Next: 081,  Prev: 083,  Up: Changelog\n\n4.5 0.8.2\n=========\n\n*Fixes*\n\n   • Deduplicate grouped membership events.\n\n\u001f\nFile: dockAviIV.info,  Node: 081,  Next: 08,  Prev: 082,  Up: Changelog\n\n4.6 0.8.1\n=========\n\nAdded missing changelog entry (of course).\n\n\u001f\nFile: dockAviIV.info,  Node: 08,  Next: 07,  Prev: 081,  Up: Changelog\n\n4.7 0.8\n=======\n\n*Additions*\n   • Command ‘ement-create-space’ creates a new space.\n   • Command ‘ement-room-toggle-space’ toggles a room’s membership in a\n     space (a way to group rooms in Matrix).\n   • Visibility of sections in the room list is saved across sessions.\n   • Command ‘ement-room-list-kill-buffer’ kills a room’s buffer from\n     the room list.\n   • Set ‘device_id’ and ‘initial_device_display_name’ upon login (e.g.\n     ‘Ement.el: username@hostname’).  (#134\n     (https://github.com/alphapapa/ement.el/issues/134).  Thanks to Arto\n     Jantunen (https://github.com/viiru-) for reporting.)\n\n   *Changes*\n\n   • Room-related commands may be called interactively with a universal\n     prefix to prompt for the room/session (allowing to send events or\n     change settings in rooms other than the current one).\n   • Command ‘ement-room-list’ reuses an existing window showing the\n     room list when possible.  (#131\n     (https://github.com/alphapapa/ement.el/issues/131).  Thanks to Jeff\n     Bowman (https://github.com/jeffbowman) for suggesting.)\n   • Command ‘ement-tag-room’ toggles tags (rather than adding by\n     default and removing when called with a prefix).\n   • Default room grouping now groups \"spaced\" rooms separately.\n\n   *Fixes*\n\n   • Message format filter works properly when writing replies.\n   • Improve insertion of sender name headers when using the \"Elemental\"\n     message format.\n   • Prompts in commands ‘ement-leave-room’ and ‘ement-forget-room’.\n\n\u001f\nFile: dockAviIV.info,  Node: 07,  Next: 06,  Prev: 08,  Up: Changelog\n\n4.8 0.7\n=======\n\n*Additions*\n\n   • Command ‘ement-room-override-name’ sets a local override for a\n     room’s display name.  (Especially helpful for 1:1 rooms and bridged\n     rooms.  See MSC3015\n     (https://github.com/matrix-org/matrix-spec-proposals/pull/3015#issuecomment-1451017296).)\n\n   *Changes*\n\n   • Improve display of room tombstones (displayed at top and bottom of\n     buffer, and new room ID is linked to join).\n   • Use descriptive prompts in ‘ement-leave-room’ and\n     ‘ement-forget-room’ commands.\n\n   *Fixes*\n\n   • Command ‘ement-view-space’ when called from a room buffer.  (Thanks\n     to Richard Brežák (https://github.com/MagicRB) for reporting.)\n   • Don’t call ‘display-buffer’ when reverting room list buffer.\n     (Fixes #121 (https://github.com/alphapapa/ement.el/issues/121).\n     Thanks to mekeor (https://github.com/mekeor) for reporting.)\n   • Retry sync for network timeouts.  (Accidentally broken in v0.6.)\n\n   *Internal*\n\n   • Function ‘ement-put-account-data’ accepts ‘:room’ argument to put\n     on a room’s account data.\n\n\u001f\nFile: dockAviIV.info,  Node: 06,  Next: 052,  Prev: 07,  Up: Changelog\n\n4.9 0.6\n=======\n\n*Additions*\n   • Command ‘ement-view-space’ to view a space’s rooms in a directory\n     buffer.\n\n   *Changes*\n   • Improve ‘ement-describe-room’ command (formatting, bindings).\n\n   *Fixes*\n   • Retry sync for HTTP 502 \"Bad Gateway\" errors.\n   • Formatting of unban events.\n   • Update password authentication according to newer Matrix spec.\n     (Fixes compatibility with Conduit servers.  #66\n     (https://github.com/alphapapa/ement.el/issues/66).  Thanks to\n     Travis Peacock (https://github.com/tpeacock19), Arto Jantunen\n     (https://github.com/viiru-), and Stephen D\n     (https://github.com/scd31).)\n   • Image scaling issues.  (Thanks to Visuwesh\n     (https://github.com/vizs).)\n\n\u001f\nFile: dockAviIV.info,  Node: 052,  Next: 051,  Prev: 06,  Up: Changelog\n\n4.10 0.5.2\n==========\n\n*Fixes*\n   • Apply ‘ement-initial-sync-timeout’ properly (important for when the\n     homeserver is slow to respond).\n\n\u001f\nFile: dockAviIV.info,  Node: 051,  Next: 05,  Prev: 052,  Up: Changelog\n\n4.11 0.5.1\n==========\n\n*Fixes*\n   • Autoload ‘ement-directory’ commands.\n   • Faces in ‘ement-directory’ listings.\n\n\u001f\nFile: dockAviIV.info,  Node: 05,  Next: 041,  Prev: 051,  Up: Changelog\n\n4.12 0.5\n========\n\n*Additions*\n   • Present \"joined-and-left\" and \"rejoined-and-left\" membership event\n     pairs as such.\n   • Process and show rooms’ canonical alias events.\n\n   *Changes*\n   • The taxy.el (https://github.com/alphapapa/taxy.el)-based room list,\n     with programmable, smart grouping, is now the default\n     ‘ement-room-list’.  (The old, ‘tabulated-list-mode’-based room list\n     is available as ‘ement-tabulated-room-list’.)\n   • When selecting a room to view with completion, don’t offer spaces.\n   • When selecting a room with completion, empty aliases and topics are\n     omitted instead of being displayed as nil.\n\n   *Fixes*\n   • Use of send-message filter when replying.\n   • Replies may be written in compose buffers.\n\n\u001f\nFile: dockAviIV.info,  Node: 041,  Next: 04,  Prev: 05,  Up: Changelog\n\n4.13 0.4.1\n==========\n\n*Fixes*\n   • Don’t show \"curl process interrupted\" message when updating a read\n     marker’s position again.\n\n\u001f\nFile: dockAviIV.info,  Node: 04,  Next: 031,  Prev: 041,  Up: Changelog\n\n4.14 0.4\n========\n\n*Additions*\n   • Option ‘ement-room-unread-only-counts-notifications’, now enabled\n     by default, causes rooms’ unread status to be determined only by\n     their notification counts (which are set by the server and depend\n     on rooms’ notification settings).\n   • Command ‘ement-room-set-notification-state’ sets a room’s\n     notification state (imitating Element’s user-friendly presets).\n   • Room buffers’ Transient menus show the room’s notification state\n     (imitating Element’s user-friendly presets).\n   • Command ‘ement-set-display-name’ sets the user’s global\n     displayname.\n   • Command ‘ement-room-set-display-name’ sets the user’s displayname\n     in a room (which is also now displayed in the room’s Transient\n     menu).\n   • Column ‘Notifications’ in the ‘ement-taxy-room-list’ buffer shows\n     rooms’ notification state.\n   • Option ‘ement-interrupted-sync-hook’ allows customization of how\n     sync interruptions are handled.  (Now, by default, a warning is\n     displayed instead of merely a message.)\n\n   *Changes*\n   • When a room’s read receipt is updated, the room’s buffer is also\n     marked as unmodified.  (In concert with the new option, this makes\n     rooms’ unread status more intuitive.)\n\n   *Fixes*\n   • Binding of command ‘ement-forget-room’ in room buffers.\n   • Highlighting of ‘@room’ mentions.\n\n\u001f\nFile: dockAviIV.info,  Node: 031,  Next: 03,  Prev: 04,  Up: Changelog\n\n4.15 0.3.1\n==========\n\n*Fixes*\n   • Room unread status (when the last event in a room is sent by the\n     local user, the room is considered read).\n\n\u001f\nFile: dockAviIV.info,  Node: 03,  Next: 021,  Prev: 031,  Up: Changelog\n\n4.16 0.3\n========\n\n*Additions*\n   • Command ‘ement-directory’ shows a server’s room directory.\n   • Command ‘ement-directory-search’ searches a server’s room\n     directory.\n   • Command ‘ement-directory-next’ fetches the next batch of rooms in a\n     directory.\n   • Command ‘ement-leave-room’ accepts a ‘FORCE-P’ argument\n     (interactively, with prefix) to leave a room without prompting.\n   • Command ‘ement-forget-room’ accepts a ‘FORCE-P’ argument\n     (interactively, with prefix) to also leave the room, and to forget\n     it without prompting.\n   • Option ‘ement-notify-mark-frame-urgent-predicates’ marks the frame\n     as urgent when (by default) a message mentions the local user or\n     \"@room\" and the message’s room has an open buffer.\n\n   *Changes*\n   • Minor improvements to date/time headers.\n\n   *Fixes*\n   • Command ‘ement-describe-room’ for rooms without topics.\n   • Improve insertion of old messages around existing timestamp\n     headers.\n   • Reduce D-Bus notification system check timeout to 2 seconds (from\n     the default of 25).\n   • Compatibility with Emacs 27.\n\n\u001f\nFile: dockAviIV.info,  Node: 021,  Next: 02,  Prev: 03,  Up: Changelog\n\n4.17 0.2.1\n==========\n\n*Fixes*\n   • Info manual export filename.\n\n\u001f\nFile: dockAviIV.info,  Node: 02,  Next: 014,  Prev: 021,  Up: Changelog\n\n4.18 0.2\n========\n\n*Changes*\n   • Read receipts are re-enabled.  (They’re now implemented with a\n     global idle timer rather than ‘window-scroll-functions’, which\n     sometimes caused a strange race condition that could cause Emacs to\n     become unresponsive or crash.)\n   • When determining whether a room is considered unread, non-message\n     events like membership changes, reactions, etc.  are ignored.  This\n     fixes a bug that caused certain rooms that had no message events\n     (like some bridged rooms) to appear as unread when they shouldn’t\n     have.  But it’s unclear whether this is always preferable (e.g.\n     one might want a member leaving a room to cause it to be marked\n     unread), so this is classified as a change rather than simply a\n     fix, and more improvements may be made to this in the future.\n     (Fixes #97 (https://github.com/alphapapa/ement.el/issues/97).\n     Thanks to Julien Roy (https://github.com/MrRoy) for reporting and\n     testing.)\n   • The ‘ement-taxy-room-list’ view no longer automatically refreshes\n     the list if the region is active in the buffer.  (This allows the\n     user to operate on multiple rooms without the contents of the\n     buffer changing before completing the process.)\n\n   *Fixes*\n   • Links to only rooms (as opposed to links to events in rooms) may be\n     activated to join them.\n   • Read receipts mark the last completely visible event (rather than\n     one that’s only partially displayed).\n   • Prevent error when a room avatar image fails to load.\n\n\u001f\nFile: dockAviIV.info,  Node: 014,  Next: 013,  Prev: 02,  Up: Changelog\n\n4.19 0.1.4\n==========\n\n*Fixed*\n   • Info manual directory headers.\n\n\u001f\nFile: dockAviIV.info,  Node: 013,  Next: 012,  Prev: 014,  Up: Changelog\n\n4.20 0.1.3\n==========\n\n*Fixed*\n\n   • Temporarily disable sending of read receipts due to an unusual bug\n     that could cause Emacs to become unresponsive.  (The feature will\n     be re-enabled in a future release.)\n\n\u001f\nFile: dockAviIV.info,  Node: 012,  Next: 011,  Prev: 013,  Up: Changelog\n\n4.21 0.1.2\n==========\n\n*Fixed*\n   • Function ‘ement-room-sync’ correctly updates room-list buffers.\n     (Thanks to Visuwesh (https://github.com/vizs).)\n   • Only send D-Bus notifications when supported.  (Fixes #83\n     (https://github.com/alphapapa/ement.el/issues/83).  Thanks to\n     Tassilo Horn (https://github.com/tsdh).)\n\n\u001f\nFile: dockAviIV.info,  Node: 011,  Next: 01,  Prev: 012,  Up: Changelog\n\n4.22 0.1.1\n==========\n\n*Fixed*\n   • Function ‘ement-room-scroll-up-mark-read’ selects the correct room\n     window.\n   • Option ‘ement-room-list-avatars’ defaults to what function\n     ‘display-images-p’ returns.\n\n\u001f\nFile: dockAviIV.info,  Node: 01,  Prev: 011,  Up: Changelog\n\n4.23 0.1\n========\n\nAfter almost two years of development, the first tagged release.\nSubmitted to GNU ELPA.\n\n\u001f\nFile: dockAviIV.info,  Node: Development,  Next: License,  Prev: Changelog,  Up: Top\n\n5 Development\n*************\n\nBug reports, feature requests, suggestions — _oh my_!\n\n* Menu:\n\n* Copyright Assignment::\n* Matrix spec in Org format::\n\n\u001f\nFile: dockAviIV.info,  Node: Copyright Assignment,  Next: Matrix spec in Org format,  Up: Development\n\n5.1 Copyright Assignment\n========================\n\nEment.el is published in GNU ELPA and is considered part of GNU Emacs.\nTherefore, cumulative contributions of more than 15 lines of code\nrequire that the author assign copyright of such contributions to the\nFSF.  Authors who are interested in doing so may contact assign@gnu.org\n to request the appropriate form.\n\n\u001f\nFile: dockAviIV.info,  Node: Matrix spec in Org format,  Prev: Copyright Assignment,  Up: Development\n\n5.2 Matrix spec in Org format\n=============================\n\nAn Org-formatted version of the Matrix spec is available in the\nmeta/spec (https://github.com/alphapapa/ement.el/tree/meta/spec) branch.\n\n\u001f\nFile: dockAviIV.info,  Node: License,  Prev: Development,  Up: Top\n\n6 License\n*********\n\nGPLv3\n\n\n\u001f\nTag Table:\nNode: Top188\nNode: Installation1434\nNode: GNU ELPA1619\nNode: GNU Guix1968\nNode: Debian2173\nNode: Git master2384\nNode: Manual3275\nNode: Usage3571\nNode: Bindings6207\nNode: Room buffers6679\nNode: Room list buffer9084\nNode: Directory buffers9492\nNode: Mentions/notifications buffers9763\nNode: Tips10157\nNode: Displaying symbols and emojis12583\nNode: Encrypted room support through Pantalaimon13210\nNode: Rationale13774\nNode: Changelog17205\nNode: 09217625\nNode: 09117806\nNode: 0917976\nNode: 08319652\nNode: 08220288\nNode: 08120441\nNode: 0820581\nNode: 0722215\nNode: 0623399\nNode: 05224204\nNode: 05124427\nNode: 0524630\nNode: 04125482\nNode: 0425696\nNode: 03127218\nNode: 0327443\nNode: 02128677\nNode: 0228819\nNode: 01430458\nNode: 01330603\nNode: 01230898\nNode: 01131312\nNode: 0131617\nNode: Development31788\nNode: Copyright Assignment32027\nNode: Matrix spec in Org format32513\nNode: License32817\n\u001f\nEnd Tag Table\n\n\u001f\nLocal Variables:\ncoding: utf-8\nEnd:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"images","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":486863,"end":486880},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486880},"to":{"change":3,"start":486862,"end":486862},"introduced_by":3}],"inode":{"change":3,"pos":486862}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"emacs-with-fully-read-line.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1510014,"end":1510055},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1510055},"to":{"change":3,"start":1417550,"end":1417550},"introduced_by":3}],"inode":{"change":3,"pos":1417550}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1417550},"to":{"change":3,"start":1417551,"end":1510013},"introduced_by":3}],"inode":{"change":3,"pos":1417550}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"ement-for-twim.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1417519,"end":1417548},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1417548},"to":{"change":3,"start":1270151,"end":1270151},"introduced_by":3}],"inode":{"change":3,"pos":1270151}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1270151},"to":{"change":3,"start":1270152,"end":1417518},"introduced_by":3}],"inode":{"change":3,"pos":1270151}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"logo-128px.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1270124,"end":1270149},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1270149},"to":{"change":3,"start":1260399,"end":1260399},"introduced_by":3}],"inode":{"change":3,"pos":1260399}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1260399},"to":{"change":3,"start":1260400,"end":1270123},"introduced_by":3}],"inode":{"change":3,"pos":1260399}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"logo.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1260378,"end":1260397},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1260397},"to":{"change":3,"start":1231014,"end":1231014},"introduced_by":3}],"inode":{"change":3,"pos":1231014}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1231014},"to":{"change":3,"start":1231015,"end":1260377},"introduced_by":3}],"inode":{"change":3,"pos":1231014}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"logo.svg","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1230980,"end":1231012},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1231012},"to":{"change":3,"start":1205022,"end":1205022},"introduced_by":3}],"inode":{"change":3,"pos":1205022}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1205022},"to":{"change":3,"start":1205023,"end":1230979},"introduced_by":3}],"inode":{"change":3,"pos":1205022}},"content":[{"Del":"\nimage/svg+xmll\n.\n"}]}},{"FileDel":{"deleted_names":[{"basename":"logo2.svg","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1204987,"end":1205020},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1205020},"to":{"change":3,"start":1152839,"end":1152839},"introduced_by":3}],"inode":{"change":3,"pos":1152839}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1152839},"to":{"change":3,"start":1152840,"end":1204986},"introduced_by":3}],"inode":{"change":3,"pos":1152839}},"content":[{"Del":"\nimage/svg+xmll\n.\n"}]}},{"FileDel":{"deleted_names":[{"basename":"logo64-2.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1152814,"end":1152837},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1152837},"to":{"change":3,"start":1145361,"end":1145361},"introduced_by":3}],"inode":{"change":3,"pos":1145361}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1145361},"to":{"change":3,"start":1145362,"end":1152813},"introduced_by":3}],"inode":{"change":3,"pos":1145361}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"logo64.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1145338,"end":1145359},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1145359},"to":{"change":3,"start":1140144,"end":1140144},"introduced_by":3}],"inode":{"change":3,"pos":1140144}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1140144},"to":{"change":3,"start":1140145,"end":1145337},"introduced_by":3}],"inode":{"change":3,"pos":1140144}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"reactions.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1140118,"end":1140142},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1140142},"to":{"change":3,"start":1120169,"end":1120169},"introduced_by":3}],"inode":{"change":3,"pos":1120169}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1120169},"to":{"change":3,"start":1120170,"end":1140117},"introduced_by":3}],"inode":{"change":3,"pos":1120169}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"screenshot.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1120142,"end":1120167},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1120167},"to":{"change":3,"start":1059379,"end":1059379},"introduced_by":3}],"inode":{"change":3,"pos":1059379}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":1059379},"to":{"change":3,"start":1059380,"end":1120141},"introduced_by":3}],"inode":{"change":3,"pos":1059379}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"screenshot2.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":1059351,"end":1059377},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":1059377},"to":{"change":3,"start":978255,"end":978255},"introduced_by":3}],"inode":{"change":3,"pos":978255}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":978255},"to":{"change":3,"start":978256,"end":1059350},"introduced_by":3}],"inode":{"change":3,"pos":978255}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"screenshot3.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":978227,"end":978253},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":978253},"to":{"change":3,"start":922497,"end":922497},"introduced_by":3}],"inode":{"change":3,"pos":922497}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":922497},"to":{"change":3,"start":922498,"end":978226},"introduced_by":3}],"inode":{"change":3,"pos":922497}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"screenshot4.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":922469,"end":922495},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":922495},"to":{"change":3,"start":793977,"end":793977},"introduced_by":3}],"inode":{"change":3,"pos":793977}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":793977},"to":{"change":3,"start":793978,"end":922468},"introduced_by":3}],"inode":{"change":3,"pos":793977}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"screenshot5.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":793949,"end":793975},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":793975},"to":{"change":3,"start":518876,"end":518876},"introduced_by":3}],"inode":{"change":3,"pos":518876}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":518876},"to":{"change":3,"start":518877,"end":793948},"introduced_by":3}],"inode":{"change":3,"pos":518876}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"transient.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486862},"to":{"change":3,"start":518850,"end":518874},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":518874},"to":{"change":3,"start":486882,"end":486882},"introduced_by":3}],"inode":{"change":3,"pos":486882}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":486882},"to":{"change":3,"start":486883,"end":518849},"introduced_by":3}],"inode":{"change":3,"pos":486882}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"tests","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":483987},"to":{"change":3,"start":484013,"end":484029},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":484029},"to":{"change":3,"start":484012,"end":484012},"introduced_by":3}],"inode":{"change":3,"pos":484012}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"ement-tests.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":484012},"to":{"change":3,"start":486822,"end":486860},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":486860},"to":{"change":3,"start":484031,"end":484031},"introduced_by":3}],"inode":{"change":3,"pos":484031}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":484031},"to":{"change":3,"start":484032,"end":486821},"introduced_by":3}],"inode":{"change":3,"pos":484031}},"content":[{"Del":";;; ement-tests.el --- Tests for Ement.el                  -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2023  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \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(require 'ert)\n(require 'map)\n\n(require 'ement-lib)\n\n;;;; Tests\n\n(ert-deftest ement--format-body-mentions ()\n  (let ((room (make-ement-room\n               :members (map-into\n                         `((\"@foo:matrix.org\" . ,(make-ement-user :id \"@foo:matrix.org\"\n                                                                  :displayname \"foo\"))\n                           (\"@bar:matrix.org\" . ,(make-ement-user :id \"@bar:matrix.org\"\n                                                                  :displayname \"bar\")))\n                         '(hash-table :test equal)))))\n    (should (equal (ement--format-body-mentions \"@foo: hi\" room)\n                   \"foo: hi\"))\n    (should (equal (ement--format-body-mentions \"@foo:matrix.org: hi\" room)\n                   \"foo: hi\"))\n    (should (equal (ement--format-body-mentions \"foo: hi\" room)\n                   \"foo: hi\"))\n    (should (equal (ement--format-body-mentions \"@foo and @bar:matrix.org: hi\" room)\n                   \"foo and bar: hi\"))\n    (should (equal (ement--format-body-mentions \"foo: how about you and @bar ...\" room)\n                   \"foo: how about you and bar ...\"))\n    (should (equal (ement--format-body-mentions \"Hello, @foo:matrix.org.\" room)\n                   \"Hello, foo.\"))\n    (should (equal (ement--format-body-mentions \"Hello, @foo:matrix.org, how are you?\" room)\n                   \"Hello, foo, how are you?\"))))\n\n(provide 'ement-tests)\n\n;;; ement-tests.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"plz-0.3.signed","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":26379260,"end":26379298},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379298},"to":{"change":3,"start":26379104,"end":26379104},"introduced_by":3}],"inode":{"change":3,"pos":26379104}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26379104},"to":{"change":3,"start":26379105,"end":26379259},"introduced_by":3}],"inode":{"change":3,"pos":26379104}},"content":[{"Del":"Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019)  (trust undefined) created at 2022-12-31T17:05:05-0500 using RSA"}]}},{"FileDel":{"deleted_names":[{"basename":"plz-0.3","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":26379301,"end":26379319},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379319},"to":{"change":3,"start":26379300,"end":26379300},"introduced_by":3}],"inode":{"change":3,"pos":26379300}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":".github","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26513985,"end":26514003},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26514003},"to":{"change":3,"start":26513984,"end":26513984},"introduced_by":3}],"inode":{"change":3,"pos":26513984}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"workflows","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26513984},"to":{"change":3,"start":26514006,"end":26514026},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26514026},"to":{"change":3,"start":26514005,"end":26514005},"introduced_by":3}],"inode":{"change":3,"pos":26514005}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"test.yml","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26514005},"to":{"change":3,"start":26516338,"end":26516370},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26516370},"to":{"change":3,"start":26514028,"end":26514028},"introduced_by":3}],"inode":{"change":3,"pos":26514028}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26514028},"to":{"change":3,"start":26514029,"end":26516337},"introduced_by":3}],"inode":{"change":3,"pos":26514028}},"content":[{"Del":"# * test.yml --- Test Emacs packages using makem.sh on GitHub Actions\n\n# URL: https://github.com/alphapapa/makem.sh\n# Version: 0.6-pre\n\n# * Commentary:\n\n# Based on Steve Purcell's examples at\n# ,\n# .\n\n# * License:\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\nname: \"CI\"\non:\n  pull_request:\n  push:\n    # Comment out this section to enable testing of all branches.\n    branches:\n      - master\n\njobs:\n  build:\n    runs-on: ubuntu-latest\n    strategy:\n      fail-fast: false\n      matrix:\n        emacs_version:\n          - 26.3\n          - 27.1\n          - snapshot\n    steps:\n    - uses: purcell/setup-emacs@master\n      with:\n        version: ${{ matrix.emacs_version }}\n\n    - uses: actions/checkout@v2\n\n    - name: Install Ispell\n      run: |\n        sudo apt-get install ispell\n\n    - name: Initialize sandbox\n      run: |\n        SANDBOX_DIR=$(mktemp -d) || exit 1\n        echo \"SANDBOX_DIR=$SANDBOX_DIR\" >> $GITHUB_ENV\n        ./makem.sh -vv --sandbox=$SANDBOX_DIR --install-deps --install-linters\n\n    # The \"all\" rule is not used, because it treats compilation warnings\n    # as failures, so linting and testing are run as separate steps.\n\n    - name: Lint\n      # NOTE: Uncomment this line to treat lint failures as passing\n      #       so the job doesn't show failure.\n      # continue-on-error: true\n      run: ./makem.sh -vv --sandbox=$SANDBOX_DIR lint\n\n    - name: Test\n      if: always()  # Run test even if linting fails.\n      run: ./makem.sh -vv --sandbox=$SANDBOX_DIR test\n\n# Local Variables:\n# eval: (outline-minor-mode)\n# End:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"README-elpa","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26513947,"end":26513982},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26513982},"to":{"change":3,"start":26504420,"end":26504420},"introduced_by":3}],"inode":{"change":3,"pos":26504420}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26504420},"to":{"change":3,"start":26504421,"end":26513946},"introduced_by":3}],"inode":{"change":3,"pos":26504420}},"content":[{"Del":"\t\t\t\t━━━━━━━━\n\t\t\t\t PLZ.EL\n\t\t\t\t━━━━━━━━\n\n\n[file:http://elpa.gnu.org/packages/plz.svg]\n\n`plz' is an HTTP library for Emacs.  It uses `curl' as a backend, which\navoids some of the issues with using Emacs's built-in `url' library.  It\nsupports both synchronous and asynchronous requests.  Its API is\nintended to be simple, natural, and expressive.  Its code is intended to\nbe simple and well-organized.  Every feature is tested against\n[httpbin].\n\n\n[file:http://elpa.gnu.org/packages/plz.svg]\n\n\n[httpbin] \n\n\n1 Installation\n══════════════\n\n1.1 GNU ELPA\n────────────\n\n  `plz' is available in [GNU ELPA].  It may be installed in Emacs using\n  the `package-install' command.\n\n\n[GNU ELPA] \n\n\n1.2 Manual\n──────────\n\n  `plz' has no dependencies other than Emacs and `curl'.  It's known to\n  work on Emacs 26.3 or later.  To install it manually, simply place\n  `plz.el' in your `load-path' and `(require 'plz)'.\n\n\n2 Usage\n═══════\n\n  The main public function is `plz', which sends an HTTP request and\n  returns either the result of the specified type (for a synchronous\n  request), or the `curl' process object (for asynchronous requests).\n  For asynchronous requests, callback, error-handling, and finalizer\n  functions may be specified, as well as various other options.\n\n\n2.1 Examples\n────────────\n\n  Synchronously `GET' a URL and return the response body as a decoded\n  string (here, raw JSON):\n\n  ┌────\n  │ (plz 'get \"https://httpbin.org/user-agent\")\n  └────\n\n  ┌────\n  │ \"{\\n \\\"user-agent\\\": \\\"curl/7.35.0\\\"\\n}\\n\"\n  └────\n\n  Synchronously `GET' a URL that returns a JSON object, and parse and\n  return it as an alist:\n\n  ┌────\n  │ (plz 'get \"https://httpbin.org/get\" :as #'json-read)\n  └────\n\n  ┌────\n  │ ((args)\n  │  (headers\n  │   (Accept . \"*/*\")\n  │   (Accept-Encoding . \"deflate, gzip\")\n  │   (Host . \"httpbin.org\")\n  │   (User-Agent . \"curl/7.35.0\"))\n  │  (url . \"https://httpbin.org/get\"))\n  └────\n\n  Asynchronously `POST' a JSON object in the request body, then parse a\n  JSON object from the response body, and call a function with the\n  result:\n\n  ┌────\n  │ (plz 'post \"https://httpbin.org/post\"\n  │   :headers '((\"Content-Type\" . \"application/json\"))\n  │   :body (json-encode '((\"key\" . \"value\")))\n  │   :as #'json-read\n  │   :then (lambda (alist)\n  │ \t  (message \"Result: %s\" (alist-get 'data alist))))\n  └────\n\n  ┌────\n  │ Result: {\"key\":\"value\"}\n  └────\n\n\n  Synchronously download a JPEG file, then create an Emacs image object\n  from the data:\n\n  ┌────\n  │ (let ((jpeg-data (plz 'get \"https://httpbin.org/image/jpeg\" :as 'binary)))\n  │   (create-image jpeg-data nil 'data))\n  └────\n\n  ┌────\n  │ (image :type jpeg :data \"\"ÿØÿà^@^PJFIF...\")\n  └────\n\n\n2.2 Functions\n─────────────\n\n  `plz'\n        /(method url &key headers body else finally noquery (as 'string)\n        (then 'sync) (body-type 'text) (decode t decode-s)\n        (connect-timeout plz-connect-timeout) (timeout plz-timeout))/\n\n        Request `METHOD' from `URL' with curl.  Return the curl process\n        object or, for a synchronous request, the selected result.\n\n        `HEADERS' may be an alist of extra headers to send with the\n        request.\n\n        `BODY-TYPE' may be `text' to send `BODY' as text, or `binary' to\n        send it as binary.\n\n        `AS' selects the kind of result to pass to the callback function\n        `THEN', or the kind of result to return for synchronous\n        requests.  It may be:\n\n        • `buffer' to pass the response buffer.\n        • `binary' to pass the response body as an undecoded string.\n        • `string' to pass the response body as a decoded string.\n        • `response' to pass a `plz-response' struct.\n        • A function, to pass its return value; it is called in the\n          response buffer, which is narrowed to the response body\n          (suitable for, e.g. `json-read').\n        • `file' to pass a temporary filename to which the response\n          body has been saved without decoding.\n        • `(file FILENAME)' to pass `FILENAME' after having saved the\n          response body to it without decoding.  `FILENAME' must be a\n          non-existent file; if it exists, it will not be overwritten,\n          and an error will be signaled.\n\n        If `DECODE' is non-nil, the response body is decoded\n        automatically.  For binary content, it should be nil.  When `AS'\n        is `binary', `DECODE' is automatically set to nil.\n\n        `THEN' is a callback function, whose sole argument is selected\n        above with `AS'.  Or `THEN' may be `sync' to make a synchronous\n        request, in which case the result is returned directly.\n\n        `ELSE' is an optional callback function called when the request\n        fails with one argument, a `plz-error' struct.  If `ELSE' is\n        nil, an error is signaled when the request fails, either\n        `plz-curl-error' or `plz-http-error' as appropriate, with a\n        `plz-error' struct as the error data.  For synchronous requests,\n        this argument is ignored.\n\n        `FINALLY' is an optional function called without argument after\n        `THEN' or `ELSE', as appropriate.  For synchronous requests,\n        this argument is ignored.\n\n        `CONNECT-TIMEOUT' and `TIMEOUT' are a number of seconds that\n        limit how long it takes to connect to a host and to receive a\n        response from a host, respectively.\n\n        `NOQUERY' is passed to `make-process', which see.\n\n\n2.3 Queueing\n────────────\n\n  `plz' provides a simple system for queueing HTTP requests.  First,\n  make a `plz-queue' struct by calling `make-plz-queue'.  Then call\n  `plz-queue' with the struct as the first argument, and the rest of the\n  arguments being the same as those passed to `plz'.  Then call\n  `plz-run' to run the queued requests.\n\n  All of the queue-related functions return the queue as their value,\n  making them easy to use.  For example:\n\n  ┌────\n  │ (defvar my-queue (make-plz-queue :limit 2))\n  │ \n  │ (plz-run\n  │  (plz-queue my-queue\n  │    'get \"https://httpbin.org/get?foo=0\"\n  │    :then (lambda (body) (message \"%s\" body))))\n  └────\n\n  Or:\n\n  ┌────\n  │ (let ((queue (make-plz-queue :limit 2))\n  │       (urls '(\"https://httpbin.org/get?foo=0\"\n  │ \t      \"https://httpbin.org/get?foo=1\")))\n  │   (plz-run\n  │    (dolist (url urls queue)\n  │      (plz-queue queue 'get url\n  │        :then (lambda (body) (message \"%s\" body))))))\n  └────\n\n  You may also clear a queue with `plz-clear', which cancels any active\n  or queued requests and calls their `:else' functions.  And\n  `plz-length' returns the number of a queue's active and queued\n  requests.\n\n\n2.4 Tips\n────────\n\n  ⁃ You can customize settings in the `plz' group, but this can only be\n    used to adjust a few defaults.  It's not intended that changing or\n    binding global variables be necessary for normal operation.\n\n\n3 Changelog\n═══════════\n\n3.1 0.3\n───────\n\n  *Additions*\n  ⁃ Handle HTTP proxy headers from Curl. ([#2].  Thanks to [Alan Third]\n    and [Sawyer Zheng] for reporting.)\n\n  *Fixes*\n  ⁃ Replaced words not in Ispell's default dictionaries (so `checkdoc'\n    linting succeeds).\n\n\n[#2] \n\n[Alan Third] \n\n[Sawyer Zheng] \n\n\n3.2 0.2.1\n─────────\n\n  *Fixes*\n  ⁃ Handle when Curl process is interrupted.\n\n\n3.3 0.2\n───────\n\n  *Added*\n  ⁃ Simple request queueing.\n\n\n3.4 0.1\n───────\n\n  Initial release.\n\n\n4 Credits\n═════════\n\n  ⁃ Thanks to [Chris Wellons], author of the [Elfeed] feed reader and\n    the popular blog [null program], for his invaluable advice, review,\n    and encouragement.\n\n\n[Chris Wellons] \n\n[Elfeed] \n\n[null program] \n\n\n5 Development\n═════════════\n\n  Bug reports, feature requests, suggestions — /oh my/!\n\n  Note that `plz' is a young library, and its only client so far is\n  [Ement.el].  There are a variety of HTTP and `curl' features it does\n  not yet support, since they have not been needed by the author.\n  Patches are welcome, as long as they include passing tests.\n\n\n[Ement.el] \n\n5.1 Copyright assignment\n────────────────────────\n\n  This package is part of [GNU Emacs], being distributed in [GNU ELPA].\n  Contributions to this project must follow GNU guidelines, which means\n  that, as with other parts of Emacs, patches of more than a few lines\n  must be accompanied by having assigned copyright for the contribution\n  to the FSF.  Contributors who wish to do so may contact\n  [emacs-devel@gnu.org] to request the assignment form.\n\n\n[GNU Emacs] \n\n[GNU ELPA] \n\n[emacs-devel@gnu.org] \n\n\n6 License\n═════════\n\n  GPLv3\n"}]}},{"FileDel":{"deleted_names":[{"basename":"README.org","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26504384,"end":26504418},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26504418},"to":{"change":3,"start":26493674,"end":26493674},"introduced_by":3}],"inode":{"change":3,"pos":26493674}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26493674},"to":{"change":3,"start":26493675,"end":26504383},"introduced_by":3}],"inode":{"change":3,"pos":26493674}},"content":[{"Del":"#+TITLE: plz.el\n\n#+PROPERTY: LOGGING nil\n\n# Note: This readme works with the org-make-toc  package, which automatically updates the table of contents.\n\n[[http://elpa.gnu.org/packages/plz.html][file:http://elpa.gnu.org/packages/plz.svg]]\n\n#+HTML: \n\n~plz~ is an HTTP library for Emacs.  It uses ~curl~ as a backend, which avoids some of the issues with using Emacs's built-in ~url~ library.  It supports both synchronous and asynchronous requests.  Its API is intended to be simple, natural, and expressive.  Its code is intended to be simple and well-organized.  Every feature is tested against [[https://httpbin.org/][httpbin]].\n\n* Contents                                                         :noexport:\n:PROPERTIES:\n:TOC:      :include siblings\n:END:\n:CONTENTS:\n- [[#installation][Installation]]\n- [[#usage][Usage]]\n  - [[#examples][Examples]]\n  - [[#functions][Functions]]\n  - [[#queueing][Queueing]]\n- [[#changelog][Changelog]]\n- [[#credits][Credits]]\n- [[#development][Development]]\n  - [[#copyright-assignment][Copyright assignment]]\n:END:\n\n* Installation\n:PROPERTIES:\n:TOC:      :depth 0\n:END:\n\n** GNU ELPA\n\n~plz~ is available in [[http://elpa.gnu.org/packages/plz.html][GNU ELPA]].  It may be installed in Emacs using the ~package-install~ command.\n\n** Manual\n\n ~plz~ has no dependencies other than Emacs and ~curl~.  It's known to work on Emacs 26.3 or later.  To install it manually, simply place =plz.el= in your ~load-path~ and ~(require 'plz)~.\n\n* Usage\n:PROPERTIES:\n:TOC:      :depth 1\n:END:\n\nThe main public function is ~plz~, which sends an HTTP request and returns either the result of the specified type (for a synchronous request), or the ~curl~ process object (for asynchronous requests).  For asynchronous requests, callback, error-handling, and finalizer functions may be specified, as well as various other options.\n\n** Examples\n\nSynchronously =GET= a URL and return the response body as a decoded string (here, raw JSON):\n\n#+BEGIN_SRC elisp :exports both :results value code :cache yes\n  (plz 'get \"https://httpbin.org/user-agent\")\n#+END_SRC\n\n#+RESULTS:\n#+BEGIN_SRC elisp\n  \"{\\n \\\"user-agent\\\": \\\"curl/7.35.0\\\"\\n}\\n\"\n#+END_SRC\n\nSynchronously =GET= a URL that returns a JSON object, and parse and return it as an alist:\n\n#+BEGIN_SRC elisp :exports both :results value code :cache yes\n  (plz 'get \"https://httpbin.org/get\" :as #'json-read)\n#+END_SRC\n\n#+RESULTS:\n#+BEGIN_SRC elisp\n  ((args)\n   (headers\n    (Accept . \"*/*\")\n    (Accept-Encoding . \"deflate, gzip\")\n    (Host . \"httpbin.org\")\n    (User-Agent . \"curl/7.35.0\"))\n   (url . \"https://httpbin.org/get\"))\n#+END_SRC\n\nAsynchronously =POST= a JSON object in the request body, then parse a JSON object from the response body, and call a function with the result:\n\n#+BEGIN_SRC elisp :exports both :cache yes\n  (plz 'post \"https://httpbin.org/post\"\n    :headers '((\"Content-Type\" . \"application/json\"))\n    :body (json-encode '((\"key\" . \"value\")))\n    :as #'json-read\n    :then (lambda (alist)\n            (message \"Result: %s\" (alist-get 'data alist))))\n#+END_SRC\n\n#+RESULTS:\n: Result: {\"key\":\"value\"}\n\nSynchronously download a JPEG file, then create an Emacs image object from the data:\n\n#+BEGIN_SRC elisp :exports both :cache yes\n  (let ((jpeg-data (plz 'get \"https://httpbin.org/image/jpeg\" :as 'binary)))\n    (create-image jpeg-data nil 'data))\n#+END_SRC\n\n#+RESULTS:\n: (image :type jpeg :data \"\"ÿØÿà^@^PJFIF...\")\n\n** Functions\n\n+  ~plz~ :: /(method url &key headers body else finally noquery (as 'string) (then 'sync) (body-type 'text) (decode t decode-s) (connect-timeout plz-connect-timeout) (timeout plz-timeout))/\n\n   Request ~METHOD~ from ~URL~ with curl.  Return the curl process object or, for a synchronous request, the selected result.\n\n   ~HEADERS~ may be an alist of extra headers to send with the request.\n\n   ~BODY-TYPE~ may be ~text~ to send ~BODY~ as text, or ~binary~ to send it as binary.\n\n   ~AS~ selects the kind of result to pass to the callback function ~THEN~, or the kind of result to return for synchronous requests.  It may be:\n\n   -  ~buffer~ to pass the response buffer.\n   -  ~binary~ to pass the response body as an undecoded string.\n   -  ~string~ to pass the response body as a decoded string.\n   -  ~response~ to pass a ~plz-response~ struct.\n   -  A function, to pass its return value; it is called in the response buffer, which is narrowed to the response body (suitable for, e.g. ~json-read~).\n   -  ~file~ to pass a temporary filename to which the response body has been saved without decoding.\n   -  ~(file FILENAME)~ to pass ~FILENAME~ after having saved the response body to it without decoding.  ~FILENAME~ must be a non-existent file; if it exists, it will not be overwritten, and an error will be signaled.\n\n   If ~DECODE~ is non-nil, the response body is decoded automatically.  For binary content, it should be nil.  When ~AS~ is ~binary~, ~DECODE~ is automatically set to nil.\n\n   ~THEN~ is a callback function, whose sole argument is selected above with ~AS~.  Or ~THEN~ may be ~sync~ to make a synchronous request, in which case the result is returned directly.\n\n   ~ELSE~ is an optional callback function called when the request fails with one argument, a ~plz-error~ struct.  If ~ELSE~ is nil, an error is signaled when the request fails, either ~plz-curl-error~ or ~plz-http-error~ as appropriate, with a ~plz-error~ struct as the error data.  For synchronous requests, this argument is ignored.\n\n   ~FINALLY~ is an optional function called without argument after ~THEN~ or ~ELSE~, as appropriate.  For synchronous requests, this argument is ignored.\n\n   ~CONNECT-TIMEOUT~ and ~TIMEOUT~ are a number of seconds that limit how long it takes to connect to a host and to receive a response from a host, respectively.\n\n   ~NOQUERY~ is passed to ~make-process~, which see.\n\n** Queueing\n\n~plz~ provides a simple system for queueing HTTP requests.  First, make a ~plz-queue~ struct by calling ~make-plz-queue~.  Then call ~plz-queue~ with the struct as the first argument, and the rest of the arguments being the same as those passed to ~plz~.  Then call ~plz-run~ to run the queued requests.\n\nAll of the queue-related functions return the queue as their value, making them easy to use.  For example:\n\n#+begin_src elisp\n  (defvar my-queue (make-plz-queue :limit 2))\n\n  (plz-run\n   (plz-queue my-queue\n     'get \"https://httpbin.org/get?foo=0\"\n     :then (lambda (body) (message \"%s\" body))))\n#+end_src\n\nOr:\n\n#+begin_src elisp\n  (let ((queue (make-plz-queue :limit 2))\n        (urls '(\"https://httpbin.org/get?foo=0\"\n                \"https://httpbin.org/get?foo=1\")))\n    (plz-run\n     (dolist (url urls queue)\n       (plz-queue queue 'get url\n         :then (lambda (body) (message \"%s\" body))))))\n#+end_src\n\nYou may also clear a queue with ~plz-clear~, which cancels any active or queued requests and calls their ~:else~ functions.  And ~plz-length~ returns the number of a queue's active and queued requests.\n\n** Tips\n:PROPERTIES:\n:TOC:      :ignore (this)\n:END:\n\n+ You can customize settings in the =plz= group, but this can only be used to adjust a few defaults.  It's not intended that changing or binding global variables be necessary for normal operation.\n\n* Changelog\n:PROPERTIES:\n:TOC:      :depth 0\n:END:\n\n** 0.3\n\n*Additions*\n+ Handle HTTP proxy headers from Curl. ([[https://github.com/alphapapa/plz.el/issues/2][#2]].  Thanks to [[https://github.com/alanthird][Alan Third]] and [[https://github.com/sawyerzheng][Sawyer Zheng]] for reporting.)\n\n*Fixes*\n+ Replaced words not in Ispell's default dictionaries (so ~checkdoc~ linting succeeds).\n\n** 0.2.1\n\n*Fixes*\n+ Handle when Curl process is interrupted.\n\n** 0.2\n\n*Added*\n+ Simple request queueing.\n\n** 0.1\n\nInitial release.\n\n* Credits\n\n+  Thanks to [[https://github.com/skeeto][Chris Wellons]], author of the [[https://github.com/skeeto/elfeed][Elfeed]] feed reader and the popular blog [[https://nullprogram.com/][null program]], for his invaluable advice, review, and encouragement.\n\n* Development\n\nBug reports, feature requests, suggestions — /oh my/!\n\nNote that ~plz~ is a young library, and its only client so far is [[https://github.com/alphapapa/ement.el][Ement.el]].  There are a variety of HTTP and ~curl~ features it does not yet support, since they have not been needed by the author.  Patches are welcome, as long as they include passing tests.\n\n** Copyright assignment\n\nThis package is part of [[https://www.gnu.org/software/emacs/][GNU Emacs]], being distributed in [[https://elpa.gnu.org/][GNU ELPA]].  Contributions to this project must follow GNU guidelines, which means that, as with other parts of Emacs, patches of more than a few lines must be accompanied by having assigned copyright for the contribution to the FSF.  Contributors who wish to do so may contact [[mailto:emacs-devel@gnu.org][emacs-devel@gnu.org]] to request the assignment form.\n\n* License\n:PROPERTIES:\n:TOC:      :ignore (this)\n:END:\n\nGPLv3\n\n* COMMENT Export setup                                             :noexport:\n:PROPERTIES:\n:TOC:      :ignore (this descendants)\n:END:\n\n# Copied from org-super-agenda's readme, in which much was borrowed from Org's =org-manual.org=.\n\n#+OPTIONS: broken-links:t *:t\n\n** Info export options\n\n#+TEXINFO_DIR_CATEGORY: Emacs\n#+TEXINFO_DIR_TITLE: Plz: (plz)\n#+TEXINFO_DIR_DESC: HTTP library using Curl as a backend\n\n# NOTE: We could use these, but that causes a pointless error, \"org-compile-file: File \"..README.info\" wasn't produced...\", so we just rename the files in the after-save-hook instead.\n# #+TEXINFO_FILENAME: plz.info\n# #+EXPORT_FILE_NAME: plz.texi\n\n** File-local variables\n\n# NOTE: Setting org-comment-string buffer-locally is a nasty hack to work around GitHub's org-ruby's HTML rendering, which does not respect noexport tags.  The only way to hide this tree from its output is to use the COMMENT keyword, but that prevents Org from processing the export options declared in it.  So since these file-local variables don't affect org-ruby, wet set org-comment-string to an unused keyword, which prevents Org from deleting this tree from the export buffer, which allows it to find the export options in it.  And since org-export does respect the noexport tag, the tree is excluded from the info page.\n\n# Local Variables:\n# eval: (require 'org-make-toc)\n# after-save-hook: (lambda nil (when (and (require 'ox-texinfo nil t) (org-texinfo-export-to-info)) (delete-file \"README.texi\") (rename-file \"README.info\" \"plz.info\" t)))\n# before-save-hook: org-make-toc\n# org-export-with-properties: ()\n# org-export-with-title: t\n# org-export-initial-scope: buffer\n# org-comment-string: \"NOTCOMMENT\"\n# End:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"dir","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26493645,"end":26493672},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26493672},"to":{"change":3,"start":26493102,"end":26493102},"introduced_by":3}],"inode":{"change":3,"pos":26493102}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26493102},"to":{"change":3,"start":26493103,"end":26493644},"introduced_by":3}],"inode":{"change":3,"pos":26493102}},"content":[{"Del":"This is the file .../info/dir, which contains the\ntopmost node of the Info hierarchy, called (dir)Top.\nThe first time you invoke Info you start off looking at this node.\n\u001f\nFile: dir,\tNode: Top\tThis is the top of the INFO tree\n\n  This (the Directory node) gives a menu of major topics.\n  Typing \"q\" exits, \"H\" lists all Info commands, \"d\" returns here,\n  \"h\" gives a primer for first-timers,\n  \"mEmacs\" visits the Emacs manual, etc.\n\n  In Emacs, you can click mouse button 2 on a menu item or cross reference\n  to select it.\n\n* Menu:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"images","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26443523,"end":26443540},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26443540},"to":{"change":3,"start":26443522,"end":26443522},"introduced_by":3}],"inode":{"change":3,"pos":26443522}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"mascot.png","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26443522},"to":{"change":3,"start":26493079,"end":26493100},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26493100},"to":{"change":3,"start":26443542,"end":26443542},"introduced_by":3}],"inode":{"change":3,"pos":26443542}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26443542},"to":{"change":3,"start":26443543,"end":26493078},"introduced_by":3}],"inode":{"change":3,"pos":26443542}},"content":[]}},{"FileDel":{"deleted_names":[{"basename":"plz-autoloads.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26443480,"end":26443520},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26443520},"to":{"change":3,"start":26442902,"end":26442902},"introduced_by":3}],"inode":{"change":3,"pos":26442902}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26442902},"to":{"change":3,"start":26442903,"end":26443479},"introduced_by":3}],"inode":{"change":3,"pos":26442902}},"content":[{"Del":";;; plz-autoloads.el --- automatically extracted autoloads  -*- lexical-binding: t -*-\n;;\n;;; Code:\n\n(add-to-list 'load-path (directory-file-name\n                         (or (file-name-directory #$) (car load-path))))\n\n\f\n;;;### (autoloads nil \"plz\" \"plz.el\" (0 0 0 0))\n;;; Generated autoloads from plz.el\n\n(register-definition-prefixes \"plz\" '(\"plz-\"))\n\n;;;***\n\f\n;;;### (autoloads nil nil (\"plz-pkg.el\") (0 0 0 0))\n\n;;;***\n\f\n;; Local Variables:\n;; version-control: never\n;; no-byte-compile: t\n;; no-update-autoloads: t\n;; coding: utf-8\n;; End:\n;;; plz-autoloads.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"plz-pkg.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26442866,"end":26442900},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26442900},"to":{"change":3,"start":26442495,"end":26442495},"introduced_by":3}],"inode":{"change":3,"pos":26442495}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26442495},"to":{"change":3,"start":26442496,"end":26442865},"introduced_by":3}],"inode":{"change":3,"pos":26442495}},"content":[{"Del":";; Generated package description from plz.el  -*- no-byte-compile: t -*-\n(define-package \"plz\" \"0.3\" \"HTTP library\" '((emacs \"26.3\")) :commit \"ecd1de2a7967bd8bc61737078d717d0ee050b344\" :authors '((\"Adam Porter\" . \"adam@alphapapa.net\")) :maintainer '(\"Adam Porter\" . \"adam@alphapapa.net\") :keywords '(\"comm\" \"network\" \"http\") :url \"https://github.com/alphapapa/plz.el\")\n"}]}},{"FileDel":{"deleted_names":[{"basename":"plz.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26442463,"end":26442493},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26442493},"to":{"change":3,"start":26408969,"end":26408969},"introduced_by":3}],"inode":{"change":3,"pos":26408969}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26408969},"to":{"change":3,"start":26408970,"end":26442462},"introduced_by":3}],"inode":{"change":3,"pos":26408969}},"content":[{"Del":";;; plz.el --- HTTP library                         -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2019-2022  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \n;; URL: https://github.com/alphapapa/plz.el\n;; Version: 0.3\n;; Package-Requires: ((emacs \"26.3\"))\n;; Keywords: comm, network, http\n\n;; This file is part of GNU Emacs.\n\n;;; License:\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;; An HTTP library that uses curl as a backend.  Inspired by, and some\n;; code copied from, Christopher Wellons's library, elfeed-curl.el.\n;;\n;; Why this package?\n;;\n;; 1.  `url' works well for many things, but it has some issues.\n;; 2.  `request' works well for many things, but it has some issues.\n;; 3.  Chris Wellons doesn't have time to factor his excellent\n;;     elfeed-curl.el library out of Elfeed.  This will have to do.\n;;\n;; Why is it called `plz'?\n;;\n;; 1.  There's already a package called `http'.\n;; 2.  There's already a package called `request'.\n;; 3.  Naming things is hard.\n\n;;;; Usage:\n\n;; Call function `plz' to make an HTTP request.  Its docstring\n;; explains its arguments.  `plz' also supports other HTTP methods,\n;; uploading and downloading binary files, sending URL parameters and\n;; HTTP headers, configurable timeouts, error-handling \"else\" and\n;; always-called \"finally\" functions, and more.\n\n;; Basic usage is simple.  For example, to make a synchronous request\n;; and return the HTTP response body as a string:\n;;\n;;   (plz 'get \"https://httpbin.org/get\")\n;;\n;; Which returns the JSON object as a string:\n;;\n;;   \"{\n;;     \\\"args\\\": {},\n;;     \\\"headers\\\": {\n;;       \\\"Accept\\\": \\\"*/*\\\",\n;;       \\\"Accept-Encoding\\\": \\\"deflate, gzip\\\",\n;;       \\\"Host\\\": \\\"httpbin.org\\\",\n;;       \\\"User-Agent\\\": \\\"curl/7.35.0\\\"\n;;     },\n;;     \\\"origin\\\": \\\"xxx.xxx.xxx.xxx\\\",\n;;     \\\"url\\\": \\\"https://httpbin.org/get\\\"\n;;   }\"\n;;\n;; To make the same request asynchronously, decoding the JSON and\n;; printing a message with a value from it:\n;;\n;;   (plz 'get \"https://httpbin.org/get\" :as #'json-read\n;;     :then (lambda (alist) (message \"URL: %s\" (alist-get 'url alist))))\n;;\n;; Which, after the request returns, prints:\n;;\n;;   URL: https://httpbin.org/get\n\n;;;; Credits:\n\n;; Thanks to Chris Wellons for inspiration, encouragement, and advice.\n\n;;; Code:\n\n;;;; Requirements\n\n(require 'cl-lib)\n(require 'rx)\n(require 'subr-x)\n\n;;;; Errors\n\n;; FIXME: `condition-case' can't catch these...?\n(define-error 'plz-curl-error \"Curl error\")\n(define-error 'plz-http-error \"HTTP error\")\n\n;;;; Structs\n\n(cl-defstruct plz-response\n  version status headers body)\n\n(cl-defstruct plz-error\n  curl-error response message)\n\n;;;; Constants\n\n(defconst plz-http-response-status-line-regexp\n  (rx \"HTTP/\" (group (or \"1.0\" \"1.1\" \"2\")) \" \"\n      ;; Status code\n      (group (1+ digit)) \" \"\n      ;; Reason phrase\n      (optional (group (1+ (not (any \"\\r\\n\")))))\n      (or\n       ;; HTTP 1\n       \"\\r\\n\"\n       ;; HTTP 2\n       \"\\n\"))\n  \"Regular expression matching HTTP response status line.\")\n\n(defconst plz-http-end-of-headers-regexp\n  (rx (or \"\\r\\n\\r\\n\" \"\\n\\n\"))\n  \"Regular expression matching the end of HTTP headers.\nThis must work with both HTTP/1 (using CRLF) and HTTP/2 (using\nonly LF).\")\n\n(defconst plz-curl-errors\n  ;; Copied from elfeed-curl.el.\n  '((1 . \"Unsupported protocol.\")\n    (2 . \"Failed to initialize.\")\n    (3 . \"URL malformed. The syntax was not correct.\")\n    (4 . \"A feature or option that was needed to perform the desired request was not enabled or was explicitly disabled at build-time.\")\n    (5 . \"Couldn't resolve proxy. The given proxy host could not be resolved.\")\n    (6 . \"Couldn't resolve host. The given remote host was not resolved.\")\n    (7 . \"Failed to connect to host.\")\n    (8 . \"FTP weird server reply. The server sent data curl couldn't parse.\")\n    (9 . \"FTP access denied.\")\n    (11 . \"FTP weird PASS reply.\")\n    (13 . \"FTP weird PASV reply.\")\n    (14 . \"FTP weird 227 format.\")\n    (15 . \"FTP can't get host.\")\n    (17 . \"FTP couldn't set binary.\")\n    (18 . \"Partial file. Only a part of the file was transferred.\")\n    (19 . \"FTP couldn't download/access the given file, the RETR (or similar) command failed.\")\n    (21 . \"FTP quote error. A quote command returned error from the server.\")\n    (22 . \"HTTP page not retrieved.\")\n    (23 . \"Write error.\")\n    (25 . \"FTP couldn't STOR file.\")\n    (26 . \"Read error. Various reading problems.\")\n    (27 . \"Out of memory. A memory allocation request failed.\")\n    (28 . \"Operation timeout.\")\n    (30 . \"FTP PORT failed.\")\n    (31 . \"FTP couldn't use REST.\")\n    (33 . \"HTTP range error. The range \\\"command\\\" didn't work.\")\n    (34 . \"HTTP post error. Internal post-request generation error.\")\n    (35 . \"SSL connect error. The SSL handshaking failed.\")\n    (36 . \"FTP bad download resume.\")\n    (37 . \"FILE couldn't read file.\")\n    (38 . \"LDAP bind operation failed.\")\n    (39 . \"LDAP search failed.\")\n    (41 . \"Function not found. A required LDAP function was not found.\")\n    (42 . \"Aborted by callback.\")\n    (43 . \"Internal error. A function was called with a bad parameter.\")\n    (45 . \"Interface error. A specified outgoing interface could not be used.\")\n    (47 . \"Too many redirects.\")\n    (48 . \"Unknown option specified to libcurl.\")\n    (49 . \"Malformed telnet option.\")\n    (51 . \"The peer's SSL certificate or SSH MD5 fingerprint was not OK.\")\n    (52 . \"The server didn't reply anything, which here is considered an error.\")\n    (53 . \"SSL crypto engine not found.\")\n    (54 . \"Cannot set SSL crypto engine as default.\")\n    (55 . \"Failed sending network data.\")\n    (56 . \"Failure in receiving network data.\")\n    (58 . \"Problem with the local certificate.\")\n    (59 . \"Couldn't use specified SSL cipher.\")\n    (60 . \"Peer certificate cannot be authenticated with known CA certificates.\")\n    (61 . \"Unrecognized transfer encoding.\")\n    (62 . \"Invalid LDAP URL.\")\n    (63 . \"Maximum file size exceeded.\")\n    (64 . \"Requested FTP SSL level failed.\")\n    (65 . \"Sending the data requires a rewind that failed.\")\n    (66 . \"Failed to initialise SSL Engine.\")\n    (67 . \"The user name, password, or similar was not accepted and curl failed to log in.\")\n    (68 . \"File not found on TFTP server.\")\n    (69 . \"Permission problem on TFTP server.\")\n    (70 . \"Out of disk space on TFTP server.\")\n    (71 . \"Illegal TFTP operation.\")\n    (72 . \"Unknown TFTP transfer ID.\")\n    (73 . \"File already exists (TFTP).\")\n    (74 . \"No such user (TFTP).\")\n    (75 . \"Character conversion failed.\")\n    (76 . \"Character conversion functions required.\")\n    (77 . \"Problem with reading the SSL CA cert (path? access rights?).\")\n    (78 . \"The resource referenced in the URL does not exist.\")\n    (79 . \"An unspecified error occurred during the SSH session.\")\n    (80 . \"Failed to shut down the SSL connection.\")\n    (82 . \"Could not load CRL file, missing or wrong format (added in 7.19.0).\")\n    (83 . \"Issuer check failed (added in 7.19.0).\")\n    (84 . \"The FTP PRET command failed\")\n    (85 . \"RTSP: mismatch of CSeq numbers\")\n    (86 . \"RTSP: mismatch of Session Identifiers\")\n    (87 . \"unable to parse FTP file list\")\n    (88 . \"FTP chunk callback reported error\")\n    (89 . \"No connection available, the session will be queued\")\n    (90 . \"SSL public key does not matched pinned public key\"))\n  \"Alist mapping curl error code integers to helpful error messages.\")\n\n;;;; Variables\n\n(defvar-local plz-else nil\n  \"Callback function for unsuccessful completion of request.\nCalled in current curl process buffer.\")\n\n(defvar-local plz-then nil\n  \"Callback function for successful completion of request.\nCalled in current curl process buffer.\")\n\n(defvar-local plz-finally nil\n  \"Function called unconditionally after completion of request.\nCalled after the then/else function, without arguments, outside\nthe curl process buffer.\")\n\n(defvar-local plz-result nil\n  \"Used when `plz' is called synchronously.\")\n\n(defvar-local plz-sync nil\n  \"Used when `plz' is called synchronously.\")\n\n;;;; Customization\n\n(defgroup plz nil\n  \"Options for `plz'.\"\n  :group 'network\n  :link '(url-link \"https://github.com/alphapapa/plz.el\"))\n\n(defcustom plz-curl-program \"curl\"\n  \"Name of curl program to call.\"\n  :type 'string)\n\n(defcustom plz-curl-default-args\n  '(\"--silent\"\n    \"--compressed\"\n    \"--location\"\n    \"--dump-header\" \"-\")\n  \"Default arguments to curl.\nNote that these arguments are passed on the command line, which\nmay be visible to other users on the local system.\"\n  :type '(repeat string))\n\n(defcustom plz-connect-timeout 5\n  \"Default connection timeout in seconds.\nThis limits how long the connection phase may last (the\n\\\"--connect-timeout\\\" argument to curl).\"\n  :type 'number)\n\n(defcustom plz-timeout 60\n  \"Default request timeout in seconds.\nThis limits how long an entire request may take, including the\nconnection phase and waiting to receive the response (the\n\\\"--max-time\\\" argument to curl).\"\n  :type 'number)\n\n;;;; Functions\n\n;;;;; Public\n\n(cl-defun plz (method url &key headers body else finally noquery\n                      (as 'string) (then 'sync)\n                      (body-type 'text) (decode t decode-s)\n                      (connect-timeout plz-connect-timeout) (timeout plz-timeout))\n  \"Request METHOD from URL with curl.\nReturn the curl process object or, for a synchronous request, the\nselected result.\n\nHEADERS may be an alist of extra headers to send with the\nrequest.\n\nBODY-TYPE may be `text' to send BODY as text, or `binary' to send\nit as binary.\n\nAS selects the kind of result to pass to the callback function\nTHEN, or the kind of result to return for synchronous requests.\nIt may be:\n\n- `buffer' to pass the response buffer.\n\n- `binary' to pass the response body as an un-decoded string.\n\n- `string' to pass the response body as a decoded string.\n\n- `response' to pass a `plz-response' structure.\n\n- `file' to pass a temporary filename to which the response body\n  has been saved without decoding.\n\n- `(file FILENAME)' to pass FILENAME after having saved the\n  response body to it without decoding.  FILENAME must be a\n  non-existent file; if it exists, it will not be overwritten,\n  and an error will be signaled.\n\n- A function, which is called in the response buffer with it\n  narrowed to the response body (suitable for, e.g. `json-read').\n\nIf DECODE is non-nil, the response body is decoded automatically.\nFor binary content, it should be nil.  When AS is `binary',\nDECODE is automatically set to nil.\n\nTHEN is a callback function, whose sole argument is selected\nabove with AS.  Or THEN may be `sync' to make a synchronous\nrequest, in which case the result is returned directly.\n\nELSE is an optional callback function called when the request\nfails with one argument, a `plz-error' structure.  If ELSE is\nnil, an error is signaled when the request fails, either\n`plz-curl-error' or `plz-http-error' as appropriate, with a\n`plz-error' structure as the error data.  For synchronous\nrequests, this argument is ignored.\n\nFINALLY is an optional function called without argument after\nTHEN or ELSE, as appropriate.  For synchronous requests, this\nargument is ignored.\n\nCONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit\nhow long it takes to connect to a host and to receive a response\nfrom a host, respectively.\n\nNOQUERY is passed to `make-process', which see.\"\n  ;; Inspired by and copied from `elfeed-curl-retrieve'.\n  (declare (indent defun))\n  (setf decode (if (and decode-s (not decode))\n                   nil decode))\n  ;; NOTE: By default, for PUT requests and POST requests >1KB, curl sends an\n  ;; \"Expect:\" header, which causes servers to send a \"100 Continue\" response, which\n  ;; we don't want to have to deal with, so we disable it by setting the header to\n  ;; the empty string.  See .\n  ;; TODO: Handle \"100 Continue\" responses and remove this workaround.\n  (push (cons \"Expect\" \"\") headers)\n  (let* ((data-arg (pcase-exhaustive body-type\n                     ('binary \"--data-binary\")\n                     ('text \"--data\")))\n         (curl-command-line-args (append plz-curl-default-args\n                                         (list \"--config\" \"-\")))\n         (curl-config-header-args (cl-loop for (key . value) in headers\n                                           collect (cons \"--header\" (format \"%s: %s\" key value))))\n         (curl-config-args (append curl-config-header-args\n                                   (list (cons \"--url\" url))\n                                   (when connect-timeout\n                                     (list (cons \"--connect-timeout\"\n                                                 (number-to-string connect-timeout))))\n                                   (when timeout\n                                     (list (cons \"--max-time\" (number-to-string timeout))))\n                                   (pcase method\n                                     ((or 'put 'post)\n                                      (cl-assert body)\n                                      (list (cons \"--request\" (upcase (symbol-name method)))\n                                            ;; It appears that this must be the last argument\n                                            ;; in order to pass data on the rest of STDIN.\n                                            (cons data-arg \"@-\")))\n                                     ('delete\n                                      (list (cons \"--request\" (upcase (symbol-name method))))))))\n         (curl-config (cl-loop for (key . value) in curl-config-args\n                               concat (format \"%s \\\"%s\\\"\\n\" key value)))\n         (decode (pcase as\n                   ('binary nil)\n                   (_ decode)))\n         sync-p)\n    (when (eq 'sync then)\n      (setf sync-p t\n            then (lambda (result)\n                   (setf plz-result result))))\n    (with-current-buffer (generate-new-buffer \" *plz-request-curl*\")\n      ;; Avoid making process in a nonexistent directory (in case the current\n      ;; default-directory has since been removed).  It's unclear what the best\n      ;; directory is, but this seems to make sense, and it should still exist.\n      (let ((default-directory temporary-file-directory)\n            (process (make-process :name \"plz-request-curl\"\n                                   :buffer (current-buffer)\n                                   :coding 'binary\n                                   :command (append (list plz-curl-program) curl-command-line-args)\n                                   :connection-type 'pipe\n                                   :sentinel #'plz--sentinel\n                                   :stderr (current-buffer)\n                                   :noquery noquery))\n            ;; The THEN function is called in the response buffer.\n            (then (pcase-exhaustive as\n                    ((or 'binary 'string)\n                     (lambda ()\n                       (let ((coding-system (or (plz--coding-system) 'utf-8)))\n                         (pcase as\n                           ('binary (set-buffer-multibyte nil)))\n                         (plz--narrow-to-body)\n                         (when decode\n                           (decode-coding-region (point) (point-max) coding-system))\n                         (funcall then (buffer-string)))))\n                    ('buffer (lambda ()\n                               (funcall then (current-buffer))))\n                    ('response (lambda ()\n                                 (funcall then (plz--response :decode-p decode))))\n                    ('file (lambda ()\n                             (set-buffer-multibyte nil)\n                             (plz--narrow-to-body)\n                             (let ((filename (make-temp-file \"plz-\")))\n                               (condition-case err\n                                   (write-region (point-min) (point-max) filename)\n                                 ;; In case of an error writing to the file, delete the temp file\n                                 ;; and signal the error.  Ignore any errors encountered while\n                                 ;; deleting the file, which would obscure the original error.\n                                 (error (ignore-errors\n                                          (delete-file filename))\n                                        (signal (car err) (cdr err))))\n                               (funcall then filename))))\n                    (`(file ,(and (pred stringp) filename))\n                     (lambda ()\n                       (set-buffer-multibyte nil)\n                       (plz--narrow-to-body)\n                       (condition-case err\n                           (write-region (point-min) (point-max) filename nil nil nil 'excl)\n                         ;; Since we are creating the file, it seems sensible to delete it in case of an\n                         ;; error while writing to it (e.g. a disk-full error).  And we ignore any errors\n                         ;; encountered while deleting the file, which would obscure the original error.\n                         (error (ignore-errors\n                                  (when (file-exists-p filename)\n                                    (delete-file filename)))\n                                (signal (car err) (cdr err))))\n                       (funcall then filename)))\n                    ((pred functionp) (lambda ()\n                                        (let ((coding-system (or (plz--coding-system) 'utf-8)))\n                                          (plz--narrow-to-body)\n                                          (when decode\n                                            (decode-coding-region (point) (point-max) coding-system))\n                                          (funcall then (funcall as))))))))\n        (setf plz-then then\n              plz-else else\n              plz-finally finally\n              plz-sync sync-p)\n        ;; Send --config arguments.\n        (process-send-string process curl-config)\n        (when body\n          (cl-typecase body\n            (string (process-send-string process body))\n            (buffer (with-current-buffer body\n                      (process-send-region process (point-min) (point-max))))))\n        (process-send-eof process)\n        (if sync-p\n            (progn\n              (while\n                  ;; According to the Elisp manual, blocking on a process's\n                  ;; output is really this simple.  And it seems to work.\n                  (accept-process-output process))\n              (prog1 plz-result\n                (unless (eq as 'buffer)\n                  (kill-buffer))))\n          process)))))\n\n;;;;; Queue\n\n;; A simple queue system.\n\n(cl-defstruct plz-queued-request\n  \"Structure representing a queued `plz' HTTP request.\nFor more details on these slots, see arguments to the function\n`plz'.\"\n  method url headers body else finally noquery\n  as then body-type decode\n  connect-timeout timeout\n  next previous process)\n\n(cl-defstruct plz-queue\n  \"Structure forming a queue for `plz' requests.\nThe queue may be appended to (the default) and prepended to, and\nitems may be removed from the front of the queue (i.e. by\ndefault, it's FIFO).  Use functions `plz-queue', `plz-run', and\n`plz-clear' to queue, run, and clear requests, respectively.\"\n  (limit 1\n         :documentation \"Number of simultaneous requests.\")\n  (active nil\n          :documentation \"Active requests.\")\n  (requests nil\n            :documentation \"Queued requests.\")\n  (canceled-p nil\n              :documentation \"Non-nil when queue has been canceled.\")\n  first-active last-active\n  first-request last-request)\n\n(defun plz-queue (queue &rest args)\n  \"Enqueue request for ARGS on QUEUE and return QUEUE.\nTo prepend to QUEUE rather than append, it may be a list of the\nform (`prepend' QUEUE).  QUEUE is a `plz-request' queue.  ARGS\nare those passed to `plz', which see.  Use `plz-run' to start\nmaking QUEUE's requests.\"\n  (declare (indent defun))\n  (cl-assert (not (equal 'sync (plist-get (cddr args) :then))) nil\n             \"Only async requests may be queued\")\n  (pcase-let* ((`(,method ,url . ,rest) args)\n               (args `(:method ,method :url ,url ,@rest))\n               (request (apply #'make-plz-queued-request args)))\n    (pcase queue\n      (`(prepend ,queue) (plz--queue-prepend request queue))\n      (_ (plz--queue-append request queue))))\n  queue)\n\n(defun plz--queue-append (request queue)\n  \"Append REQUEST to QUEUE and return QUEUE.\"\n  (cl-check-type request plz-queued-request\n                 \"REQUEST must be a `plz-queued-request' structure.\")\n  (cl-check-type queue plz-queue\n                 \"QUEUE must be a `plz-queue' structure.\")\n  (when (plz-queue-last-request queue)\n    (setf (plz-queued-request-next (plz-queue-last-request queue)) request))\n  (setf (plz-queued-request-previous request) (plz-queue-last-request queue)\n        (plz-queue-last-request queue) request)\n  (unless (plz-queue-first-request queue)\n    (setf (plz-queue-first-request queue) request))\n  (unless (plz-queue-last-request queue)\n    (setf (plz-queue-last-request queue) request))\n  (push request (plz-queue-requests queue))\n  queue)\n\n(defun plz--queue-prepend (request queue)\n  \"Prepend REQUEST to QUEUE and return QUEUE.\"\n  (cl-check-type request plz-queued-request\n                 \"REQUEST must be a `plz-queued-request' structure.\")\n  (cl-check-type queue plz-queue\n                 \"QUEUE must be a `plz-queue' structure.\")\n  (when (plz-queue-requests queue)\n    (setf (plz-queued-request-next request) (car (plz-queue-requests queue))\n          (plz-queued-request-previous (plz-queued-request-next request)) request))\n  (setf (plz-queue-first-request queue) request)\n  (unless (plz-queue-first-request queue)\n    (setf (plz-queue-first-request queue) request))\n  (unless (plz-queue-last-request queue)\n    (setf (plz-queue-last-request queue) request))\n  (push request (plz-queue-requests queue))\n  queue)\n\n(defun plz--queue-pop (queue)\n  \"Return the first queued request on QUEUE and remove it from QUEUE.\"\n  (let* ((request (plz-queue-first-request queue))\n         (next (plz-queued-request-next request)))\n    (when next\n      (setf (plz-queued-request-previous next) nil))\n    (setf (plz-queue-first-request queue) next\n          (plz-queue-requests queue) (delq request (plz-queue-requests queue)))\n    (when (eq request (plz-queue-last-request queue))\n      (setf (plz-queue-last-request queue) nil))\n    request))\n\n(defun plz-run (queue)\n  \"Process requests in QUEUE and return QUEUE.\nReturn when QUEUE is at limit or has no more queued requests.\n\nQUEUE should be a `plz-queue' structure.\"\n  (cl-labels ((readyp\n               (queue) (and (not (plz-queue-canceled-p queue))\n                            (plz-queue-requests queue)\n                            ;; With apologies to skeeto...\n                            (< (length (plz-queue-active queue)) (plz-queue-limit queue)))))\n    (while (readyp queue)\n      (pcase-let* ((request (plz--queue-pop queue))\n                   ((cl-struct plz-queued-request method url\n                               headers body finally noquery as body-type decode connect-timeout timeout\n                               (else orig-else) (then orig-then))\n                    request)\n                   (then (lambda (response)\n                           (unwind-protect\n                               ;; Ensure any errors in the THEN function don't abort the queue.\n                               (funcall orig-then response)\n                             (setf (plz-queue-active queue) (delq request (plz-queue-active queue)))\n                             (plz-run queue))))\n                   (else (lambda (arg)\n                           (unwind-protect\n                               ;; Ensure any errors in the THEN function don't abort the queue.\n                               (when orig-else\n                                 (funcall orig-else arg))\n                             (setf (plz-queue-active queue) (delq request (plz-queue-active queue)))\n                             (plz-run queue))))\n                   (args (list method url\n                               ;; Omit arguments for which `plz' has defaults so as not to nil them.\n                               :headers headers :body body :finally finally :noquery noquery\n                               :connect-timeout connect-timeout :timeout timeout)))\n        ;; Add arguments which override defaults.\n        (when as\n          (setf args (plist-put args :as as)))\n        (when else\n          (setf args (plist-put args :else else)))\n        (when then\n          (setf args (plist-put args :then then)))\n        (when decode\n          (setf args (plist-put args :decode decode)))\n        (when body-type\n          (setf args (plist-put args :body-type body-type)))\n        (when connect-timeout\n          (setf args (plist-put args :connect-timeout connect-timeout)))\n        (when timeout\n          (setf args (plist-put args :timeout timeout)))\n        (setf (plz-queued-request-process request) (apply #'plz args))\n        (push request (plz-queue-active queue))))\n    queue))\n\n(defun plz-clear (queue)\n  \"Clear QUEUE and return it.\nCancels any active or pending requests.  For pending requests,\ntheir ELSE functions will be called with a `plz-error' structure\nwith the message, \\\"`plz' queue cleared; request canceled.\\\";\nactive requests will have their curl processes killed and their\nELSE functions called with the corresponding data.\"\n  (setf (plz-queue-canceled-p queue) t)\n  (dolist (request (plz-queue-active queue))\n    (kill-process (plz-queued-request-process request))\n    (setf (plz-queue-active queue) (delq request (plz-queue-active queue))))\n  (dolist (request (plz-queue-requests queue))\n    (funcall (plz-queued-request-else request)\n             (make-plz-error :message \"`plz' queue cleared; request canceled.\"))\n    (setf (plz-queue-requests queue) (delq request (plz-queue-requests queue))))\n  (setf (plz-queue-first-active queue) nil\n        (plz-queue-last-active queue) nil\n        (plz-queue-first-request queue) nil\n        (plz-queue-last-request queue) nil\n        (plz-queue-canceled-p queue) nil)\n  queue)\n\n(defun plz-length (queue)\n  \"Return number of of QUEUE's outstanding requests.\nIncludes active and queued requests.\"\n  (+ (length (plz-queue-active queue))\n     (length (plz-queue-requests queue))))\n\n;;;;; Private\n\n(defun plz--sentinel (process-or-buffer status)\n  \"Process buffer of curl output in PROCESS-OR-BUFFER.\nIf PROCESS-OR-BUFFER if a process, uses its buffer; if a buffer,\nuses it.  STATUS should be the process's event string (see info\nnode `(elisp) Sentinels').  Kills the buffer before returning.\"\n  ;; Inspired by and some code copied from `elfeed-curl--sentinel'.\n  (let* ((buffer (cl-etypecase process-or-buffer\n                   (process (process-buffer process-or-buffer))\n                   (buffer process-or-buffer)))\n         (finally (buffer-local-value 'plz-finally buffer))\n         sync)\n    (unwind-protect\n        (with-current-buffer buffer\n          (setf sync plz-sync)\n          (pcase-exhaustive status\n            ((or 0 \"finished\\n\")\n             ;; Curl exited normally: check HTTP status code.\n             (goto-char (point-min))\n             (plz--skip-proxy-headers)\n             (pcase (plz--http-status)\n               (200 (funcall plz-then))\n               (_ (let ((err (make-plz-error :response (plz--response))))\n                    (pcase-exhaustive plz-else\n                      (`nil (signal 'plz-http-error err))\n                      ((pred functionp) (funcall plz-else err)))))))\n\n            ((or (and (pred numberp) code)\n                 (rx \"exited abnormally with code \" (let code (group (1+ digit)))))\n             ;; Curl error.\n             (let* ((curl-exit-code (cl-typecase code\n                                      (string (string-to-number code))\n                                      (number code)))\n                    (curl-error-message (alist-get curl-exit-code plz-curl-errors))\n                    (err (make-plz-error :curl-error (cons curl-exit-code curl-error-message))))\n               (pcase-exhaustive plz-else\n                 ;; FIXME: Returning a plz-error structure which has a curl-error slot, wrapped in a plz-curl-error, is confusing.\n                 (`nil (signal 'plz-curl-error err))\n                 ((pred functionp) (funcall plz-else err)))))\n\n            ((and (or \"killed\\n\" \"interrupt\\n\") status)\n             ;; Curl process killed or interrupted.\n             (let* ((message (pcase status\n                               (\"killed\\n\" \"curl process killed\")\n                               (\"interrupt\\n\" \"curl process interrupted\")))\n                    (err (make-plz-error :message message)))\n               (pcase-exhaustive plz-else\n                 (`nil (signal 'plz-curl-error err))\n                 ((pred functionp) (funcall plz-else err)))))))\n      (when finally\n        (funcall finally))\n      (unless sync\n        (kill-buffer buffer)))))\n\n;;;;;; HTTP Responses\n\n;; Functions for parsing HTTP responses.\n\n(defun plz--skip-proxy-headers ()\n  \"Skip proxy headers in current buffer.\"\n  (when (looking-at plz-http-response-status-line-regexp)\n    (let* ((status-code (string-to-number (match-string 2)))\n           (reason-phrase (match-string 3)))\n      (when (and (equal 200 status-code)\n                 (equal \"Connection established\" reason-phrase))\n        ;; Skip proxy headers (curl apparently offers no way to omit\n        ;; them).\n        (unless (re-search-forward \"\\r\\n\\r\\n\" nil t)\n          (signal 'plz-http-error '(\"plz--response: End of proxy headers not found\")))))))\n\n(cl-defun plz--response (&key (decode-p t))\n  \"Return response structure for HTTP response in current buffer.\nWhen DECODE-P is non-nil, decode the response body automatically\naccording to the apparent coding system.\n\nAssumes that point is at beginning of HTTP response.\"\n  (save-excursion\n    ;; Parse HTTP version and status code.\n    (unless (looking-at plz-http-response-status-line-regexp)\n      (signal 'plz-http-error\n              (list \"plz--response: Unable to parse HTTP response status line\"\n                    (buffer-substring (point) (line-end-position)))))\n    (let* ((http-version (string-to-number (match-string 1)))\n           (status-code (string-to-number (match-string 2)))\n           (headers (plz--headers))\n           (coding-system (or (plz--coding-system headers) 'utf-8)))\n      (plz--narrow-to-body)\n      (when decode-p\n        (decode-coding-region (point) (point-max) coding-system))\n      (make-plz-response\n       :version http-version\n       :status status-code\n       :headers headers\n       :body (buffer-string)))))\n\n(defun plz--coding-system (&optional headers)\n  \"Return coding system for HTTP response in current buffer.\nHEADERS may optionally be an alist of parsed HTTP headers to\nrefer to rather than the current buffer's unparsed headers.\"\n  (let* ((headers (or headers (plz--headers)))\n         (content-type (alist-get 'content-type headers)))\n    (when content-type\n      (coding-system-from-name content-type))))\n\n(defun plz--http-status ()\n  \"Return HTTP status code for HTTP response in current buffer.\nAssumes point is at start of HTTP response.\"\n  (when (looking-at plz-http-response-status-line-regexp)\n    (string-to-number (match-string 2))))\n\n(defun plz--headers ()\n  \"Return headers alist for HTTP response in current buffer.\nAssumes point is at start of HTTP response.\"\n  (save-excursion\n    (forward-line 1)\n    (let ((limit (save-excursion\n                   (re-search-forward plz-http-end-of-headers-regexp nil)\n                   (point))))\n      (cl-loop while (re-search-forward (rx bol (group (1+ (not (in \":\")))) \":\" (1+ blank)\n                                            (group (1+ (not (in \"\\r\\n\")))))\n                                        limit t)\n               ;; NOTE: Some HTTP servers send all-lowercase header keys, which means an alist\n               ;; lookup with `equal' or `string=' fails when the case differs.  We don't want\n               ;; users to have to worry about this, so for consistency, we downcase the\n               ;; header name.  And while we're at it, we might as well intern it so we can\n               ;; use `alist-get' without having to add \"nil nil #'equal\" every time.\n               collect (cons (intern (downcase (match-string 1))) (match-string 2))))))\n\n(defun plz--narrow-to-body ()\n  \"Narrow to body of HTTP response in current buffer.\nAssumes point is at start of HTTP response.\"\n  (unless (re-search-forward plz-http-end-of-headers-regexp nil t)\n    (signal 'plz-http-error '(\"plz--narrow-to-body: Unable to find end of headers\")))\n  (narrow-to-region (point) (point-max)))\n\n;;;; Footer\n\n(provide 'plz)\n\n;;; plz.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"plz.info","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26408935,"end":26408967},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26408967},"to":{"change":3,"start":26398071,"end":26398071},"introduced_by":3}],"inode":{"change":3,"pos":26398071}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26398071},"to":{"change":3,"start":26398072,"end":26408934},"introduced_by":3}],"inode":{"change":3,"pos":26398071}},"content":[{"Del":"This is README.info, produced by makeinfo version 5.2 from README.texi.\n\nINFO-DIR-SECTION Emacs\nSTART-INFO-DIR-ENTRY\n* Plz: (plz).           HTTP library using Curl as a backend.\nEND-INFO-DIR-ENTRY\n\n\u001f\nFile: README.info,  Node: Top,  Next: Installation,  Up: (dir)\n\nplz.el\n******\n\nfile:http://elpa.gnu.org/packages/plz.svg\n(http://elpa.gnu.org/packages/plz.html)\n\n   ‘plz’ is an HTTP library for Emacs.  It uses ‘curl’ as a backend,\nwhich avoids some of the issues with using Emacs’s built-in ‘url’\nlibrary.  It supports both synchronous and asynchronous requests.  Its\nAPI is intended to be simple, natural, and expressive.  Its code is\nintended to be simple and well-organized.  Every feature is tested\nagainst httpbin (https://httpbin.org/).\n\n* Menu:\n\n* Installation::\n* Usage::\n* Changelog::\n* Credits::\n* Development::\n* License::\n\n— The Detailed Node Listing —\n\nInstallation\n\n* GNU ELPA::\n* Manual::\n\nUsage\n\n* Examples::\n* Functions::\n* Queueing::\n* Tips::\n\nChangelog\n\n* 0.3: 03. \n* 0.2.1: 021. \n* 0.2: 02. \n* 0.1: 01. \n\nDevelopment\n\n* Copyright assignment::\n\n\n\u001f\nFile: README.info,  Node: Installation,  Next: Usage,  Prev: Top,  Up: Top\n\n1 Installation\n**************\n\n* Menu:\n\n* GNU ELPA::\n* Manual::\n\n\u001f\nFile: README.info,  Node: GNU ELPA,  Next: Manual,  Up: Installation\n\n1.1 GNU ELPA\n============\n\n‘plz’ is available in GNU ELPA (http://elpa.gnu.org/packages/plz.html).\nIt may be installed in Emacs using the ‘package-install’ command.\n\n\u001f\nFile: README.info,  Node: Manual,  Prev: GNU ELPA,  Up: Installation\n\n1.2 Manual\n==========\n\n‘plz’ has no dependencies other than Emacs and ‘curl’.  It’s known to\nwork on Emacs 26.3 or later.  To install it manually, simply place\n‘plz.el’ in your ‘load-path’ and ‘(require 'plz)’.\n\n\u001f\nFile: README.info,  Node: Usage,  Next: Changelog,  Prev: Installation,  Up: Top\n\n2 Usage\n*******\n\nThe main public function is ‘plz’, which sends an HTTP request and\nreturns either the result of the specified type (for a synchronous\nrequest), or the ‘curl’ process object (for asynchronous requests).  For\nasynchronous requests, callback, error-handling, and finalizer functions\nmay be specified, as well as various other options.\n\n* Menu:\n\n* Examples::\n* Functions::\n* Queueing::\n* Tips::\n\n\u001f\nFile: README.info,  Node: Examples,  Next: Functions,  Up: Usage\n\n2.1 Examples\n============\n\nSynchronously ‘GET’ a URL and return the response body as a decoded\nstring (here, raw JSON):\n\n     (plz 'get \"https://httpbin.org/user-agent\")\n\n     \"{\\n \\\"user-agent\\\": \\\"curl/7.35.0\\\"\\n}\\n\"\n\n   Synchronously ‘GET’ a URL that returns a JSON object, and parse and\nreturn it as an alist:\n\n     (plz 'get \"https://httpbin.org/get\" :as #'json-read)\n\n     ((args)\n      (headers\n       (Accept . \"*/*\")\n       (Accept-Encoding . \"deflate, gzip\")\n       (Host . \"httpbin.org\")\n       (User-Agent . \"curl/7.35.0\"))\n      (url . \"https://httpbin.org/get\"))\n\n   Asynchronously ‘POST’ a JSON object in the request body, then parse a\nJSON object from the response body, and call a function with the result:\n\n     (plz 'post \"https://httpbin.org/post\"\n       :headers '((\"Content-Type\" . \"application/json\"))\n       :body (json-encode '((\"key\" . \"value\")))\n       :as #'json-read\n       :then (lambda (alist)\n               (message \"Result: %s\" (alist-get 'data alist))))\n\n     Result: {\"key\":\"value\"}\n\n   Synchronously download a JPEG file, then create an Emacs image object\nfrom the data:\n\n     (let ((jpeg-data (plz 'get \"https://httpbin.org/image/jpeg\" :as 'binary)))\n       (create-image jpeg-data nil 'data))\n\n     (image :type jpeg :data \"\"ÿØÿà^@^PJFIF...\")\n\n\u001f\nFile: README.info,  Node: Functions,  Next: Queueing,  Prev: Examples,  Up: Usage\n\n2.2 Functions\n=============\n\n‘plz’\n     _(method url &key headers body else finally noquery (as ’string)\n     (then ’sync) (body-type ’text) (decode t decode-s) (connect-timeout\n     plz-connect-timeout) (timeout plz-timeout))_\n\n     Request ‘METHOD’ from ‘URL’ with curl.  Return the curl process\n     object or, for a synchronous request, the selected result.\n\n     ‘HEADERS’ may be an alist of extra headers to send with the\n     request.\n\n     ‘BODY-TYPE’ may be ‘text’ to send ‘BODY’ as text, or ‘binary’ to\n     send it as binary.\n\n     ‘AS’ selects the kind of result to pass to the callback function\n     ‘THEN’, or the kind of result to return for synchronous requests.\n     It may be:\n\n        • ‘buffer’ to pass the response buffer.\n        • ‘binary’ to pass the response body as an undecoded string.\n        • ‘string’ to pass the response body as a decoded string.\n        • ‘response’ to pass a ‘plz-response’ struct.\n        • A function, to pass its return value; it is called in the\n          response buffer, which is narrowed to the response body\n          (suitable for, e.g.  ‘json-read’).\n        • ‘file’ to pass a temporary filename to which the response body\n          has been saved without decoding.\n        • ‘(file FILENAME)’ to pass ‘FILENAME’ after having saved the\n          response body to it without decoding.  ‘FILENAME’ must be a\n          non-existent file; if it exists, it will not be overwritten,\n          and an error will be signaled.\n\n     If ‘DECODE’ is non-nil, the response body is decoded automatically.\n     For binary content, it should be nil.  When ‘AS’ is ‘binary’,\n     ‘DECODE’ is automatically set to nil.\n\n     ‘THEN’ is a callback function, whose sole argument is selected\n     above with ‘AS’.  Or ‘THEN’ may be ‘sync’ to make a synchronous\n     request, in which case the result is returned directly.\n\n     ‘ELSE’ is an optional callback function called when the request\n     fails with one argument, a ‘plz-error’ struct.  If ‘ELSE’ is nil,\n     an error is signaled when the request fails, either\n     ‘plz-curl-error’ or ‘plz-http-error’ as appropriate, with a\n     ‘plz-error’ struct as the error data.  For synchronous requests,\n     this argument is ignored.\n\n     ‘FINALLY’ is an optional function called without argument after\n     ‘THEN’ or ‘ELSE’, as appropriate.  For synchronous requests, this\n     argument is ignored.\n\n     ‘CONNECT-TIMEOUT’ and ‘TIMEOUT’ are a number of seconds that limit\n     how long it takes to connect to a host and to receive a response\n     from a host, respectively.\n\n     ‘NOQUERY’ is passed to ‘make-process’, which see.\n\n\u001f\nFile: README.info,  Node: Queueing,  Next: Tips,  Prev: Functions,  Up: Usage\n\n2.3 Queueing\n============\n\n‘plz’ provides a simple system for queueing HTTP requests.  First, make\na ‘plz-queue’ struct by calling ‘make-plz-queue’.  Then call ‘plz-queue’\nwith the struct as the first argument, and the rest of the arguments\nbeing the same as those passed to ‘plz’.  Then call ‘plz-run’ to run the\nqueued requests.\n\n   All of the queue-related functions return the queue as their value,\nmaking them easy to use.  For example:\n\n     (defvar my-queue (make-plz-queue :limit 2))\n\n     (plz-run\n      (plz-queue my-queue\n        'get \"https://httpbin.org/get?foo=0\"\n        :then (lambda (body) (message \"%s\" body))))\n\n   Or:\n\n     (let ((queue (make-plz-queue :limit 2))\n           (urls '(\"https://httpbin.org/get?foo=0\"\n                   \"https://httpbin.org/get?foo=1\")))\n       (plz-run\n        (dolist (url urls queue)\n          (plz-queue queue 'get url\n            :then (lambda (body) (message \"%s\" body))))))\n\n   You may also clear a queue with ‘plz-clear’, which cancels any active\nor queued requests and calls their ‘:else’ functions.  And ‘plz-length’\nreturns the number of a queue’s active and queued requests.\n\n\u001f\nFile: README.info,  Node: Tips,  Prev: Queueing,  Up: Usage\n\n2.4 Tips\n========\n\n   • You can customize settings in the ‘plz’ group, but this can only be\n     used to adjust a few defaults.  It’s not intended that changing or\n     binding global variables be necessary for normal operation.\n\n\u001f\nFile: README.info,  Node: Changelog,  Next: Credits,  Prev: Usage,  Up: Top\n\n3 Changelog\n***********\n\n* Menu:\n\n* 0.3: 03. \n* 0.2.1: 021. \n* 0.2: 02. \n* 0.1: 01. \n\n\u001f\nFile: README.info,  Node: 03,  Next: 021,  Up: Changelog\n\n3.1 0.3\n=======\n\n*Additions*\n   • Handle HTTP proxy headers from Curl.\n\n   *Fixes*\n   • Replaced words not in Ispell’s default dictionaries (so ‘checkdoc’\n     linting succeeds).\n\n\u001f\nFile: README.info,  Node: 021,  Next: 02,  Prev: 03,  Up: Changelog\n\n3.2 0.2.1\n=========\n\n*Fixes*\n   • Handle when Curl process is interrupted.\n\n\u001f\nFile: README.info,  Node: 02,  Next: 01,  Prev: 021,  Up: Changelog\n\n3.3 0.2\n=======\n\n*Added*\n   • Simple request queueing.\n\n\u001f\nFile: README.info,  Node: 01,  Prev: 02,  Up: Changelog\n\n3.4 0.1\n=======\n\nInitial release.\n\n\u001f\nFile: README.info,  Node: Credits,  Next: Development,  Prev: Changelog,  Up: Top\n\n4 Credits\n*********\n\n   • Thanks to Chris Wellons (https://github.com/skeeto), author of the\n     Elfeed (https://github.com/skeeto/elfeed) feed reader and the\n     popular blog null program (https://nullprogram.com/), for his\n     invaluable advice, review, and encouragement.\n\n\u001f\nFile: README.info,  Node: Development,  Next: License,  Prev: Credits,  Up: Top\n\n5 Development\n*************\n\nBug reports, feature requests, suggestions — _oh my_!\n\n   Note that ‘plz’ is a young library, and its only client so far is\nEment.el (https://github.com/alphapapa/ement.el).  There are a variety\nof HTTP and ‘curl’ features it does not yet support, since they have not\nbeen needed by the author.  Patches are welcome, as long as they include\npassing tests.\n\n* Menu:\n\n* Copyright assignment::\n\n\u001f\nFile: README.info,  Node: Copyright assignment,  Up: Development\n\n5.1 Copyright assignment\n========================\n\nThis package is part of GNU Emacs (https://www.gnu.org/software/emacs/),\nbeing distributed in GNU ELPA (https://elpa.gnu.org/).  Contributions to\nthis project must follow GNU guidelines, which means that, as with other\nparts of Emacs, patches of more than a few lines must be accompanied by\nhaving assigned copyright for the contribution to the FSF.  Contributors\nwho wish to do so may contact emacs-devel@gnu.org \nto request the assignment form.\n\n\u001f\nFile: README.info,  Node: License,  Prev: Development,  Up: Top\n\n6 License\n*********\n\nGPLv3\n\n\n\u001f\nTag Table:\nNode: Top199\nNode: Installation1084\nNode: GNU ELPA1227\nNode: Manual1473\nNode: Usage1779\nNode: Examples2280\nNode: Functions3647\nNode: Queueing6542\nNode: Tips7800\nNode: Changelog8101\nNode: 038266\nNode: 0218516\nNode: 028665\nNode: 018794\nNode: Credits8888\nNode: Development9254\nNode: Copyright assignment9768\nNode: License10356\n\u001f\nEnd Tag Table\n\n\u001f\nLocal Variables:\ncoding: utf-8\nEnd:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"tests","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379300},"to":{"change":3,"start":26379322,"end":26379338},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379338},"to":{"change":3,"start":26379321,"end":26379321},"introduced_by":3}],"inode":{"change":3,"pos":26379321}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"test-plz.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26379321},"to":{"change":3,"start":26398034,"end":26398069},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":26398069},"to":{"change":3,"start":26379340,"end":26379340},"introduced_by":3}],"inode":{"change":3,"pos":26379340}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":26379340},"to":{"change":3,"start":26379341,"end":26398033},"introduced_by":3}],"inode":{"change":3,"pos":26379340}},"content":[{"Del":";;; test-plz.el --- Tests for plz          -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2019-2022  Free Software Foundation, Inc.\n\n;; Author: Adam Porter \n;; Maintainer: Adam Porter \n\n;; This file is part of GNU Emacs.\n\n;;; License:\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;; NOTE: NOTE: NOTE: NOTE: Yes, four NOTEs, because this is important:\n;; As of this moment, all of the tests pass when run with makem.sh.\n;; And when running them in an interactive Emacs with ERT, one test at\n;; a time, individual tests pass, or almost always do (depending on\n;; whether the httpbin.org server is overloaded).  But when running\n;; multiple tests in ERT at one time,\n;; i.e. (ert-run-tests-interactively \"plz-\"), multiple, if not most,\n;; tests fail, but not the same ones every time.\n\n;; I have now spent hours trying to figure out why, inserting many\n;; debug statements in many functions, and come up with nothing.  I\n;; tried changing the way `accept-process-output' is called, like\n;; using timeouts or JUST-THIS-ONE, but it made no difference.  I\n;; tried calling it extra times, nope.  I tried calling the sentinel\n;; extra times when it seemed that it hadn't run the THEN function,\n;; nope.  Nothing seems to make a difference.\n\n;; I even checked out an earlier commit, before the commit that\n;; rewrote/merged the synchronous request code into the `plz'\n;; function, thinking that surely I broke something--but, nope, they\n;; apparently failed the same way back then: passing with makem.sh,\n;; passing individually, but failing when run in close succession by\n;; ERT.\n\n;; After inserting enough debug statements, I noticed that the process\n;; sentinel sometimes seemed to run for the last time after the ERT\n;; test had returned, which suggests that ERT might be doing something\n;; weird, or somehow its instrumentation interferes with the\n;; process-handling code.  But if that's not the cause, then I'm out\n;; of ideas.\n\n;; So then I tried rewriting the synchronous request code to use\n;; `call-process-region', instead of calling `accept-process-output'\n;; in a loop to block on the curl process (which is how the Elisp\n;; manual says to do it), but that still made no difference: even the\n;; async requests fail in the same way with ERT.  So that doesn't\n;; appear to be the problem, either.\n\n;; So is there some kind of fundamental flaw in the `plz' design?\n;; Maybe.  Is there a simple, logical oversight in its code that only\n;; manifests under certain conditions?  Maybe.  Is ERT doing something\n;; weird that's interfering with process-related code?  Maybe.  Is\n;; Emacs's own process-handling code still broken in some mysterious\n;; way?  Maybe.\n\n;; But despite all of that, when using `plz' \"in anger\", in `ement',\n;; it seems to work reliably for me.  I did get one report from one\n;; user that sounded like the same kind of problem I'm seeing with ERT\n;; here, but then he tried `ement-connect' again, and it worked.  And\n;; I'm sitting here watching `ement' constantly using `plz' to talk to\n;; the matrix.org server, and I haven't had a single error or failure,\n;; even after hours of being connected.  It *seems* to *actually*\n;; work.\n\n;; So, if you're reading this, and you're wondering whether you should\n;; use `plz': Well, please do, and please let me know if you have any\n;; problems; I do need to know whether it's working for other users.\n;; And if you think you might know what's going wrong when running the\n;; tests in ERT, please let me know, because I'm out of ideas: as far\n;; as I can tell, when it comes to process-handling in Emacs, \"there\n;; be dragons.\"\n\n;;; Code:\n\n;;;; Requirements\n\n(require 'ert)\n(require 'json)\n(require 'let-alist)\n\n(require 'plz)\n\n;;;; Variables\n\n\n;;;; Customization\n\n\n;;;; Commands\n\n\n;;;; Macros\n\n(cl-defun plz-test-wait (process &optional (seconds 0.1) (times 100))\n  \"Wait for SECONDS seconds TIMES times for PROCESS to finish.\"\n  (when process\n    ;; Sometimes it seems that the process is killed, the THEN\n    ;; function called by its sentinel, and its buffer killed, all\n    ;; before this function gets called with the process argument;\n    ;; when that happens, tests that use this can fail.  Testing\n    ;; whether PROCESS is non-nil seems to fix it, but it's possible\n    ;; that something funny is going on...\n    (cl-loop for i upto times ;; 10 seconds\n             while (equal 'run (process-status process))\n             do (sleep-for seconds))))\n\n;;;; Functions\n\n(defmacro plz-test-get-response (response)\n  \"Test parts of RESPONSE with `should'.\"\n  `(and (should (plz-response-p ,response))\n        (should (numberp (plz-response-version ,response)))\n        (should (eq 200 (plz-response-status ,response)))\n        (should (equal \"application/json\" (alist-get 'content-type (plz-response-headers ,response))))\n        (let* ((json (json-read-from-string (plz-response-body ,response)))\n               (headers (alist-get 'headers json))\n               (user-agent (alist-get 'User-Agent headers nil nil #'equal)))\n          (should (string-match \"curl\" user-agent)))))\n\n;;;; Tests\n\n;;;;; Async\n\n(ert-deftest plz-get-string nil\n  (let* ((test-string)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :as 'string\n                    :then (lambda (string)\n                            (setf test-string string)))))\n    (plz-test-wait process)\n    (should (string-match \"curl\" test-string))))\n\n(ert-deftest plz-get-buffer nil\n  ;; The sentinel kills the buffer, so we get the buffer as a string.\n  (let* ((test-buffer-string)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :as 'buffer\n                    :then (lambda (buffer)\n                            (with-current-buffer buffer\n                              (setf test-buffer-string (buffer-string)))))))\n    (plz-test-wait process)\n    (should (string-match \"curl\" test-buffer-string))))\n\n(ert-deftest plz-get-response nil\n  (let* ((test-response)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :as 'response\n                    :then (lambda (response)\n                            (setf test-response response)))))\n    (plz-test-wait process)\n    (plz-test-get-response test-response)))\n\n(ert-deftest plz-get-json nil\n  (let* ((test-json)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf test-json json)))))\n    (plz-test-wait process)\n    (let-alist test-json\n      (should (string-match \"curl\" .headers.User-Agent)))))\n\n(ert-deftest plz-post-json-string nil\n  (let* ((json-string (json-encode (list (cons \"key\" \"value\"))))\n         (response-json)\n         (process (plz 'post \"https://httpbin.org/post\"\n                    :headers '((\"Content-Type\" . \"application/json\"))\n                    :body json-string\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf response-json json)))))\n    (plz-test-wait process)\n    (let-alist response-json\n      (should (string-match \"curl\" .headers.User-Agent))\n      (should (string= \"value\" (alist-get 'key (json-read-from-string .data)))))))\n\n(ert-deftest plz-post-jpeg-string nil\n  (let* ((jpeg-to-upload (plz 'get \"https://httpbin.org/image/jpeg\"\n                           :as 'binary :then 'sync))\n         (_ (unless jpeg-to-upload\n              (error \"jpeg-to-upload is nil\")))\n         (response-json)\n         (response-jpeg)\n         (process (plz 'post \"https://httpbin.org/post\"\n                    :headers '((\"Content-Type\" . \"image/jpeg\"))\n                    :body jpeg-to-upload :body-type 'binary\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf response-json json\n                                  response-jpeg\n                                  (base64-decode-string\n                                   (string-remove-prefix \"data:application/octet-stream;base64,\"\n                                                         (alist-get 'data json))))))))\n    (should (equal 'jpeg (image-type-from-data jpeg-to-upload)))\n    (plz-test-wait process)\n    (should response-json)\n    (should (equal 'jpeg (image-type-from-data response-jpeg)))\n    (should (equal (length jpeg-to-upload) (length response-jpeg)))\n    (should (equal jpeg-to-upload response-jpeg))))\n\n;; TODO: POST JSON buffer.\n\n(ert-deftest plz-put-json-string nil\n  (let* ((json-string (json-encode (list (cons \"key\" \"value\"))))\n         (response-json)\n         (process (plz 'put \"https://httpbin.org/put\"\n                    :headers '((\"Content-Type\" . \"application/json\"))\n                    :body json-string\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf response-json json)))))\n    (plz-test-wait process)\n    (let-alist response-json\n      (should (string-match \"curl\" .headers.User-Agent))\n      (should (string= \"value\" (alist-get 'key (json-read-from-string .data)))))))\n\n;; TODO: Put JSON buffer.\n\n;;;;; Sync\n\n(ert-deftest plz-get-string-sync nil\n  (let-alist (json-read-from-string (plz 'get \"https://httpbin.org/get\"\n                                      :as 'string :then 'sync))\n    (should (equal \"https://httpbin.org/get\" .url))))\n\n(ert-deftest plz-get-response-sync nil\n  (plz-test-get-response (plz 'get \"https://httpbin.org/get\"\n                           :as 'response :then 'sync)))\n\n(ert-deftest plz-get-json-sync nil\n  (let-alist (plz 'get \"https://httpbin.org/get\"\n               :as #'json-read :then 'sync)\n    (should (string-match \"curl\" .headers.User-Agent))))\n\n(ert-deftest plz-get-buffer-sync nil\n  (let ((buffer (plz 'get \"https://httpbin.org/get\"\n                  :as 'buffer :then 'sync)))\n    (unwind-protect\n        (should (buffer-live-p buffer))\n      (kill-buffer buffer))))\n\n;;;;; Headers\n\n;; These tests were added when plz--curl was changed to send headers\n;; with \"--config\" rather than on the command line.\n\n(ert-deftest plz-get-with-headers ()\n  (let* ((response-json)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :headers '((\"X-Plz-Test-Header\" . \"plz-test-header-value\"))\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf response-json json)))))\n    (plz-test-wait process)\n    (let-alist response-json\n      (should (equal \"plz-test-header-value\" .headers.X-Plz-Test-Header)))))\n\n(ert-deftest plz-post-with-headers ()\n  (let* ((alist (list (cons \"key\" \"value\")))\n         (response-json)\n         (process (plz 'post \"https://httpbin.org/post\"\n                    :headers '((\"Content-Type\" . \"application/json\")\n                               (\"X-Plz-Test-Header\" . \"plz-test-header-value\"))\n                    :body (json-encode alist)\n                    :as #'json-read\n                    :then (lambda (json)\n                            (setf response-json json)))))\n    (plz-test-wait process)\n    (let-alist response-json\n      (should (equal \"plz-test-header-value\" .headers.X-Plz-Test-Header))\n      (should (equal \"value\" (alist-get 'key (json-read-from-string .data)))))))\n\n(ert-deftest plz-get-json-with-headers-sync ()\n  (let-alist (plz 'get \"https://httpbin.org/get\"\n               :headers '((\"X-Plz-Test-Header\" . \"plz-test-header-value\"))\n               :as #'json-read :then 'sync)\n    (should (string-match \"curl\" .headers.User-Agent))\n    (should (equal \"plz-test-header-value\" .headers.X-Plz-Test-Header))))\n\n;;;;; Errors\n\n(ert-deftest plz-get-curl-error nil\n  ;; Async.\n  (let* ((err)\n         (process (plz 'get \"https://httpbinnnnnn.org/get/status/404\"\n                    :as 'string\n                    :else (lambda (e)\n                            (setf err e)))))\n    (plz-test-wait process)\n    (should (and (plz-error-p err)\n                 (equal '(6 . \"Couldn't resolve host. The given remote host was not resolved.\")\n                        (plz-error-curl-error err))))))\n\n;; FIXME: This test works interactively but not in batch mode: it\n;; stalls the Emacs process indefinitely, using either sleep-for or\n;; sit-for.\n\n;; (ert-deftest plz-get-killed-error nil\n;;   ;; Async.\n;;   (let* ((err)\n;;          (process (plz 'get \"https://httpbinnnnnn.org/get/status/404\"\n;;                     :as 'string\n;;                     :else (lambda (e)\n;;                             (setf err e)))))\n;;     (sit-for 0.01)\n;;     (delete-process process)\n;;     (should (not (process-live-p process)))\n;;     (should (plz-error-p err))\n;;     (should (equal \"curl process killed\"\n;;                    (plz-error-message err)))))\n\n(ert-deftest plz-get-curl-error-sync nil\n  ;; Sync.\n  (let ((err (should-error (plz 'get \"https://httpbinnnnnn.org/get/status/404\"\n                             :as 'string :then 'sync)\n                           :type 'plz-curl-error)))\n    (should (eq 'plz-curl-error (car err)))\n    (should (plz-error-p (cdr err)))\n    (should (equal '(6 . \"Couldn't resolve host. The given remote host was not resolved.\")\n                   (plz-error-curl-error (cdr err))))))\n\n(ert-deftest plz-get-404-error nil\n  ;; FIXME: Wrap each test expression in `should' rather than using `should-and'.\n\n  ;; Async.\n  (let* ((err)\n         (process (plz 'get \"https://httpbin.org/get/status/404\"\n                    :as 'string\n                    :else (lambda (e)\n                            (setf err e)))))\n    (plz-test-wait process)\n    (should (and (plz-error-p err)\n                 (plz-response-p (plz-error-response err))\n                 (eq 404 (plz-response-status (plz-error-response err))))))\n\n  ;; Sync.\n  (let ((err (should-error (plz 'get \"https://httpbin.org/get/status/404\"\n                             :as 'string :then 'sync)\n                           :type 'plz-http-error)))\n    (should (and (eq 'plz-http-error (car err))\n                 (plz-error-p (cdr err))\n                 (plz-response-p (plz-error-response (cdr err)))\n                 (eq 404 (plz-response-status (plz-error-response (cdr err))))))))\n\n(ert-deftest plz-get-timeout-error nil\n  ;; Async.\n  (let* ((start-time (current-time))\n         (end-time)\n         (plz-error)\n         (process (plz 'get \"https://httpbin.org/delay/5\"\n                    :as 'response :timeout 1\n                    :else (lambda (e)\n                            (setf end-time (current-time)\n                                  plz-error e)))))\n    (plz-test-wait process)\n    (should (eq 28 (car (plz-error-curl-error plz-error))))\n    (should (equal \"Operation timeout.\" (cdr (plz-error-curl-error plz-error))))\n    (should (< (time-to-seconds (time-subtract end-time start-time)) 1.1)))\n\n  ;; Sync.\n  (let ((start-time (current-time))\n        (err (cdr\n              (should-error (plz 'get \"https://httpbin.org/delay/5\"\n                              :as 'string :then 'sync :timeout 1)\n                            :type 'plz-curl-error)))\n        (end-time (current-time)))\n    (should (eq 28 (car (plz-error-curl-error err))))\n    (should (equal \"Operation timeout.\" (cdr (plz-error-curl-error err))))\n    (should (< (time-to-seconds (time-subtract end-time start-time)) 1.1))))\n\n;;;;; Finally\n\n(ert-deftest plz-get-finally nil\n  (let* ((finally-null t)\n         (process (plz 'get \"https://httpbin.org/get\"\n                    :as 'string\n                    :then #'ignore\n                    :finally (lambda ()\n                               (setf finally-null nil)))))\n    (plz-test-wait process)\n    (should-not finally-null)))\n\n;;;;; Binary\n\n(ert-deftest plz-get-jpeg ()\n  (let* ((test-jpeg)\n         (process (plz 'get \"https://httpbin.org/image/jpeg\"\n                    :as 'binary\n                    :then (lambda (string)\n                            (setf test-jpeg string)))))\n    (plz-test-wait process)\n    (should (equal 'jpeg (image-type-from-data test-jpeg)))))\n\n(ert-deftest plz-get-jpeg-sync ()\n  (let ((jpeg (plz 'get \"https://httpbin.org/image/jpeg\"\n                :as 'binary :then 'sync)))\n    (should (equal 'jpeg (image-type-from-data jpeg)))))\n\n;;;;; Downloading to files\n\n(ert-deftest plz-get-temp-file ()\n  (let ((filename (plz 'get \"https://httpbin.org/image/jpeg\"\n                    :as 'file :then 'sync)))\n    (unwind-protect\n        (let ((jpeg-data (with-temp-buffer\n                           (insert-file-contents filename)\n                           (buffer-string))))\n          (should (equal 'jpeg (image-type-from-data jpeg-data))))\n      ;; It's a temp file, so it should always be deleted.\n      (delete-file filename))))\n\n(ert-deftest plz-get-named-file ()\n  (let ((filename (make-temp-file \"plz-\")))\n    ;; HACK: Delete the temp file and reuse its name, because\n    ;; `make-temp-name' is less convenient to use.\n    (delete-file filename)\n    (unwind-protect\n        (progn\n          (plz 'get \"https://httpbin.org/image/jpeg\"\n            :as `(file ,filename) :then 'sync)\n          (let ((jpeg-data (with-temp-buffer\n                             (insert-file-contents filename)\n                             (buffer-string))))\n            (should (equal 'jpeg (image-type-from-data jpeg-data)))))\n      ;; It's a temp file, so it should always be deleted.\n      (when (file-exists-p filename)\n        (delete-file filename)))))\n\n;;;;; Queue\n\n;; TODO: Test that limit is enforced (though it seems to work fine).\n\n(ert-deftest plz-queue ()\n  (let ((queue (make-plz-queue :limit 2))\n        (urls '(\"https://httpbin.org/get?foo=0\"\n                \"https://httpbin.org/get?foo=1\"))\n        completed-urls)\n    (dolist (url urls)\n      (plz-queue queue\n        'get url :then (lambda (_)\n                         (push url completed-urls))))\n    (plz-run queue)\n    (cl-loop with waits = 0\n             while (and (plz-queue-active queue) (< waits 20))\n             do (progn\n                  (sleep-for 0.1)\n                  (cl-incf waits)))\n    (and (seq-set-equal-p urls completed-urls)\n         (zerop (plz-length queue)))))\n\n;;;; Footer\n\n(provide 'test-plz)\n\n;;; test-plz.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"nadvice-0.3.signed","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":28741234,"end":28741276},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28741276},"to":{"change":3,"start":28741078,"end":28741078},"introduced_by":3}],"inode":{"change":3,"pos":28741078}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":28741078},"to":{"change":3,"start":28741079,"end":28741233},"introduced_by":3}],"inode":{"change":3,"pos":28741078}},"content":[{"Del":"Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019)  (trust undefined) created at 2019-09-21T13:55:19-0400 using RSA"}]}},{"FileDel":{"deleted_names":[{"basename":"nadvice-0.3","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":28741279,"end":28741301},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28741301},"to":{"change":3,"start":28741278,"end":28741278},"introduced_by":3}],"inode":{"change":3,"pos":28741278}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"nadvice-autoloads.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28741278},"to":{"change":3,"start":28746280,"end":28746324},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28746324},"to":{"change":3,"start":28745926,"end":28745926},"introduced_by":3}],"inode":{"change":3,"pos":28745926}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":28745926},"to":{"change":2,"start":469176,"end":469543},"introduced_by":2}],"inode":{"change":3,"pos":28745926}},"content":[{"Del":";;; nadvice-autoloads.el --- automatically extracted autoloads\r\n;;\r\n;;; Code:\r\n\r\n(add-to-list 'load-path (directory-file-name\r\n                         (or (file-name-directory #$) (car load-path))))\r\n\r\n\f\r\n;; Local Variables:\r\n;; version-control: never\r\n;; no-byte-compile: t\r\n;; no-update-autoloads: t\r\n;; coding: utf-8\r\n;; End:\r\n;;; nadvice-autoloads.el ends here\r\n"}]}},{"FileDel":{"deleted_names":[{"basename":"nadvice-pkg.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28741278},"to":{"change":3,"start":28745886,"end":28745924},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28745924},"to":{"change":3,"start":28745596,"end":28745596},"introduced_by":3}],"inode":{"change":3,"pos":28745596}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":28745596},"to":{"change":2,"start":468884,"end":469174},"introduced_by":2}],"inode":{"change":3,"pos":28745596}},"content":[{"Del":";;; -*- no-byte-compile: t -*-\r\n(define-package \"nadvice\" \"0.3\" \"Forward compatibility for Emacs-24.4's nadvice\" 'nil :url \"http://elpa.gnu.org/packages/nadvice.html\" :authors '((\"Stefan Monnier\" . \"monnier@iro.umontreal.ca\")) :maintainer '(\"Stefan Monnier\" . \"monnier@iro.umontreal.ca\"))\r\n"}]}},{"FileDel":{"deleted_names":[{"basename":"nadvice.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28741278},"to":{"change":3,"start":28745560,"end":28745594},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":28745594},"to":{"change":3,"start":28741303,"end":28741303},"introduced_by":3}],"inode":{"change":3,"pos":28741303}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":28741303},"to":{"change":2,"start":464503,"end":468882},"introduced_by":2}],"inode":{"change":3,"pos":28741303}},"content":[{"Del":";;; nadvice.el --- Forward compatibility for Emacs-24.4's nadvice\r\n\r\n;; Copyright (C) 2018  Free Software Foundation, Inc.\r\n\r\n;; Author: Stefan Monnier \r\n;; Version: 0.3\r\n;; Keywords:\r\n\r\n;; This program is free software; you can redistribute it and/or modify\r\n;; it under the terms of the GNU General Public License as published by\r\n;; the Free Software Foundation, either version 3 of the License, or\r\n;; (at your option) any later version.\r\n\r\n;; This program is distributed in the hope that it will be useful,\r\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r\n;; GNU General Public License for more details.\r\n\r\n;; You should have received a copy of the GNU General Public License\r\n;; along with this program.  If not, see .\r\n\r\n;;; Commentary:\r\n\r\n;; This package tries to re-implement some of nadvice.el's functionality\r\n;; on top of the old defadvice system, to help users of defadvice\r\n;; move to the new advice system without dropping support for Emacs<24.4.\r\n;;\r\n;; Limitations;\r\n;; - only supports `advice-add' and `advice-remove';\r\n;; - only handles the :before, :after, :override, and :around kinds of advice;\r\n;; - requires a named rather than anonymous function;\r\n;; - and does not support any additional properties like `name' or `depth'.\r\n;;\r\n;; It was tested on Emacs-22 and I can't see any obvious reason why it\r\n;; wouldn't work on older Emacsen.\r\n\r\n;;; Code:\r\n\r\n(declare-function ad-remove-advice \"advice\")\r\n\r\n(unless (fboundp 'add-function)\r\n  ;; If `add-function' is defined, we're presumably running on\r\n  ;; an Emacs that comes with the real nadvice.el, so let's be careful\r\n  ;; to do nothing in that case!\r\n\r\n  ;; Load `advice' manually, in case `advice-remove' is called first,\r\n  ;; since ad-remove-advice is not autoloaded.\r\n  (require 'advice)\r\n\r\n;;;###autoload\r\n(defun advice-add (symbol where function &optional props)\r\n  (when props\r\n    (error \"This version of nadvice.el does not support PROPS\"))\r\n  (unless (symbolp function)\r\n    (error \"This version of nadvice.el requires FUNCTION to be a symbol\"))\r\n  (let ((body (cond\r\n               ((eq where :before)\r\n                `(progn (apply #',function (ad-get-args 0)) ad-do-it))\r\n               ((eq where :after)\r\n                `(progn ad-do-it (apply #',function (ad-get-args 0))))\r\n               ((eq where :override)\r\n                `(setq ad-return-value (apply #',function (ad-get-args 0))))\r\n               ((eq where :around)\r\n                `(setq ad-return-value\r\n                       (apply #',function\r\n                              (lambda (&rest nadvice--rest-arg)\r\n                                (ad-set-args 0 nadvice--rest-arg)\r\n                                ad-do-it)\r\n                              (ad-get-args 0))))\r\n               (t (error \"This version of nadvice.el does not handle %S\"\r\n                         where)))))\r\n    (ad-add-advice symbol\r\n                   `(,function nil t (advice lambda () ,body))\r\n                   'around\r\n                   nil)\r\n    (ad-activate symbol)))\r\n\r\n;;;###autoload\r\n(defun advice-remove (symbol function)\r\n  ;; Just return nil if there is no advice, rather than signaling an\r\n  ;; error.\r\n  (condition-case nil\r\n      (ad-remove-advice symbol 'around function)\r\n    (error nil))\r\n  (condition-case nil\r\n      (ad-activate symbol)\r\n    (error nil)))\r\n\r\n)\r\n\r\n;;;; ChangeLog:\r\n\r\n;; 2018-09-15  Thomas Fitzsimmons\t\r\n;; \r\n;; \tpackages/nadvice: Fix advice-remove behaviour\r\n;; \r\n;; \t* packages/nadvice/nadvice.el: Bump version to 0.3.\r\n;; \t(advice-remove): Do not signal an error if the function already has no\r\n;; \tadvice.\r\n;; \r\n;; 2018-09-12  Stefan Monnier  \r\n;; \r\n;; \t* nadvice.el: ad-remove-advice is not autoloaded\r\n;; \r\n;; 2018-09-12  Stefan Monnier  \r\n;; \r\n;; \t* nadvice.el: Fix typo\r\n;; \r\n;; 2018-09-12  Stefan Monnier  \r\n;; \r\n;; \t* nadvice/nadvice.el (advice-add): Add support for :override\r\n;; \r\n;; 2018-09-12  Stefan Monnier  \r\n;; \r\n;; \t* nadvice.el: Fix copyright!\r\n;; \r\n;; 2018-09-12  Stefan Monnier  \r\n;; \r\n;; \t* nadvice: New forward compatibility package\r\n;; \r\n\r\n\r\n(provide 'nadvice)\r\n;;; nadvice.el ends here\r\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-20221026.1100","metadata":576}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":642063},"to":{"change":3,"start":52710338,"end":52710368},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710368},"to":{"change":3,"start":52710337,"end":52710337},"introduced_by":3}],"inode":{"change":3,"pos":52710337}}},"content_edges":null,"content":[]}},{"FileDel":{"deleted_names":[{"basename":"cider-apropos.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53620948,"end":53620988},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53620988},"to":{"change":3,"start":53611555,"end":53611555},"introduced_by":3}],"inode":{"change":3,"pos":53611555}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53611555},"to":{"change":3,"start":53611556,"end":53620947},"introduced_by":3}],"inode":{"change":3,"pos":53611555}},"content":[{"Del":";;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors\n;;\n;; Author: Jeff Valk \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Apropos functionality for Clojure.\n\n;;; Code:\n\n(require 'cider-doc) ; for cider-doc-lookup\n(require 'cider-find) ; for cider--find-var\n(require 'cider-util)\n(require 'subr-x)\n(require 'cider-connection) ; for cider-ensure-connected\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'nrepl-dict)\n\n(require 'apropos)\n(require 'button)\n\n(defconst cider-apropos-buffer \"*cider-apropos*\")\n\n(defcustom cider-apropos-actions '((\"display-doc\" . cider-doc-lookup)\n                                   (\"find-def\" . cider--find-var)\n                                   (\"lookup-on-clojuredocs\" . cider-clojuredocs-lookup))\n  \"Controls the actions to be applied on the symbol found by an apropos search.\nThe first action key in the list will be selected as default.  If the list\ncontains only one action key, the associated action function will be\napplied automatically.  An action function can be any function that receives\nthe symbol found by the apropos search as argument.\"\n  :type '(alist :key-type string :value-type function)\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(define-button-type 'apropos-special-form\n  'apropos-label \"Special form\"\n  'apropos-short-label \"s\"\n  'face 'font-lock-keyword-face\n  'help-echo \"mouse-2, RET: Display more help on this special form\"\n  'follow-link t\n  'action (lambda (button)\n            (describe-function (button-get button 'apropos-symbol))))\n\n(defun cider-apropos-doc (button)\n  \"Display documentation for the symbol represented at BUTTON.\"\n  (cider-doc-lookup (button-get button 'apropos-symbol)))\n\n(defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p)\n  \"Return a short description for the performed apropos search.\n\nQUERY can be a regular expression list of space-separated words\n\\(e.g take while) which will be converted to a regular expression\n\\(like take.+while) automatically behind the scenes.  The search may be\nlimited to the namespace NS, and may optionally search doc strings\n\\(based on DOCS-P), include private vars (based on INCLUDE-PRIVATE-P),\nand be case-sensitive (based on CASE-SENSITIVE-P).\"\n  (concat (if case-sensitive-p \"Case-sensitive \" \"\")\n          (if docs-p \"Documentation \" \"\")\n          (format \"Apropos for %S\" query)\n          (if ns (format \" in namespace %S\" ns) \"\")\n          (if include-private-p\n              \" (public and private symbols)\"\n            \" (public symbols only)\")))\n\n(defun cider-apropos-highlight (doc query)\n  \"Return the DOC string propertized to highlight QUERY matches.\"\n  (let ((pos 0))\n    (while (string-match query doc pos)\n      (setq pos (match-end 0))\n      (put-text-property (match-beginning 0)\n                         (match-end 0)\n                         'font-lock-face apropos-match-face doc)))\n  doc)\n\n(defvar cider-use-tooltips)\n(defun cider-apropos-result (result query docs-p)\n  \"Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P.\"\n  (nrepl-dbind-response result (name type doc)\n    (let* ((label (capitalize (if (string= type \"variable\") \"var\" type)))\n           (help (concat \"Display doc for this \" (downcase label)))\n           (props (list 'apropos-symbol name\n                        'action #'cider-apropos-doc))\n           (props (if cider-use-tooltips\n                      (append props (list 'help-echo help))\n                    props)))\n      (cider-propertize-region props\n        (insert-text-button name 'type 'apropos-symbol)\n        (insert \"\\n  \")\n        (insert-text-button label 'type (intern (concat \"apropos-\" type)))\n        (insert \": \")\n        (let ((beg (point)))\n          (if docs-p\n              (insert (cider-apropos-highlight doc query) \"\\n\")\n            (insert doc)\n            (fill-region beg (point))))\n        (insert \"\\n\")))))\n\n(defun cider-show-apropos (summary results query docs-p)\n  \"Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P.\"\n  (with-current-buffer (cider-popup-buffer cider-apropos-buffer 'select 'apropos-mode 'ancillary)\n    (let ((inhibit-read-only t))\n      (if (boundp 'header-line-format)\n          (setq-local header-line-format summary)\n        (insert summary \"\\n\\n\"))\n      (dolist (result results)\n        (cider-apropos-result result query docs-p))\n      (goto-char (point-min)))))\n\n;;;###autoload\n(defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p)\n  \"Show all symbols whose names match QUERY, a regular expression.\nQUERY can also be a list of space-separated words (e.g. take while) which\nwill be converted to a regular expression (like take.+while) automatically\nbehind the scenes.  The search may be limited to the namespace NS, and may\noptionally search doc strings (based on DOCS-P), include private vars\n\\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).\"\n  (interactive\n   (cons (read-string \"Search for Clojure symbol (a regular expression): \")\n         (when current-prefix-arg\n           (list (let ((ns (completing-read \"Namespace (default is all): \" (cider-sync-request:ns-list))))\n                   (if (string= ns \"\") nil ns))\n                 (y-or-n-p \"Search doc strings? \")\n                 (y-or-n-p \"Include private symbols? \")\n                 (y-or-n-p \"Case-sensitive? \")))))\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"apropos\")\n  (if-let* ((summary (cider-apropos-summary\n                      query ns docs-p privates-p case-sensitive-p))\n            (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))\n      (cider-show-apropos summary results query docs-p)\n    (message \"No apropos matches for %S\" query)))\n\n;;;###autoload\n(defun cider-apropos-documentation ()\n  \"Shortcut for (cider-apropos  nil t).\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"apropos\")\n  (cider-apropos (read-string \"Search for Clojure documentation (a regular expression): \") nil t))\n\n(defun cider-apropos-act-on-symbol (symbol)\n  \"Apply selected action on SYMBOL.\"\n  (let* ((first-action-key (car (car cider-apropos-actions)))\n         (action-key (if (= 1 (length cider-apropos-actions))\n                         first-action-key\n                       (completing-read (format \"Choose action to apply to `%s` (default %s): \"\n                                                symbol first-action-key)\n                                        cider-apropos-actions nil nil nil nil first-action-key)))\n         (action-fn (cdr (assoc action-key cider-apropos-actions))))\n    (if action-fn\n        (funcall action-fn symbol)\n      (user-error \"Unknown action `%s`\" action-key))))\n\n;;;###autoload\n(defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p)\n  \"Similar to `cider-apropos', but presents the results in a completing read.\nShow all symbols whose names match QUERY, a regular expression.\nQUERY can also be a list of space-separated words (e.g. take while) which\nwill be converted to a regular expression (like take.+while) automatically\nbehind the scenes.  The search may be limited to the namespace NS, and may\noptionally search doc strings (based on DOCS-P), include private vars\n\\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).\"\n  (interactive\n   (cons (read-string \"Search for Clojure symbol (a regular expression): \")\n         (when current-prefix-arg\n           (list (let ((ns (completing-read \"Namespace (default is all): \" (cider-sync-request:ns-list))))\n                   (if (string= ns \"\") nil ns))\n                 (y-or-n-p \"Search doc strings? \")\n                 (y-or-n-p \"Include private symbols? \")\n                 (y-or-n-p \"Case-sensitive? \")))))\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"apropos\")\n  (if-let* ((summary (cider-apropos-summary\n                      query ns docs-p privates-p case-sensitive-p))\n            (results (mapcar (lambda (r) (nrepl-dict-get r \"name\"))\n                             (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))))\n      (cider-apropos-act-on-symbol (completing-read (concat summary \": \") results))\n    (message \"No apropos matches for %S\" query)))\n\n;;;###autoload\n(defun cider-apropos-documentation-select ()\n  \"Shortcut for (cider-apropos-select  nil t).\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"apropos\")\n  (cider-apropos-select (read-string \"Search for Clojure documentation (a regular expression): \") nil t))\n\n(provide 'cider-apropos)\n\n;;; cider-apropos.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-autoloads.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53611511,"end":53611553},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53611553},"to":{"change":3,"start":53583690,"end":53583690},"introduced_by":3}],"inode":{"change":3,"pos":53583690}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53583690},"to":{"change":3,"start":53583691,"end":53611510},"introduced_by":3}],"inode":{"change":3,"pos":53583690}},"content":[{"Del":";;; cider-autoloads.el --- automatically extracted autoloads  -*- lexical-binding: t -*-\n;;\n;;; Code:\n\n(add-to-list 'load-path (directory-file-name\n                         (or (file-name-directory #$) (car load-path))))\n\n\f\n;;;### (autoloads nil \"cider\" \"cider.el\" (0 0 0 0))\n;;; Generated autoloads from cider.el\n\n(autoload 'cider-version \"cider\" \"\\\nDisplay CIDER's version.\" t nil)\n (autoload 'cider-start-map \"cider\" \"CIDER jack-in and connect keymap.\" t 'keymap)\n\n(autoload 'cider-jack-in-clj \"cider\" \"\\\nStart an nREPL server for the current project and connect to it.\nPARAMS is a plist optionally containing :project-dir and :jack-in-cmd.\nWith the prefix argument, allow editing of the jack in command; with a\ndouble prefix prompt for all these parameters.\n\n\\(fn PARAMS)\" t nil)\n\n(autoload 'cider-jack-in-cljs \"cider\" \"\\\nStart an nREPL server for the current project and connect to it.\nPARAMS is a plist optionally containing :project-dir, :jack-in-cmd and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  With the prefix argument,\nallow editing of the jack in command; with a double prefix prompt for all\nthese parameters.\n\n\\(fn PARAMS)\" t nil)\n\n(autoload 'cider-jack-in-clj&cljs \"cider\" \"\\\nStart an nREPL server and connect with clj and cljs REPLs.\nPARAMS is a plist optionally containing :project-dir, :jack-in-cmd and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  With the prefix argument,\nallow for editing of the jack in command; with a double prefix prompt for\nall these parameters.  When SOFT-CLJS-START is non-nil, start cljs REPL\nonly when the ClojureScript dependencies are met.\n\n\\(fn &optional PARAMS SOFT-CLJS-START)\" t nil)\n\n(autoload 'cider-connect-sibling-clj \"cider\" \"\\\nCreate a Clojure REPL with the same server as OTHER-REPL.\nPARAMS is for consistency with other connection commands and is currently\nignored.  OTHER-REPL defaults to `cider-current-repl' and in programs can\nalso be a server buffer, in which case a new session with a REPL for that\nserver is created.\n\n\\(fn PARAMS &optional OTHER-REPL)\" t nil)\n\n(autoload 'cider-connect-sibling-cljs \"cider\" \"\\\nCreate a ClojureScript REPL with the same server as OTHER-REPL.\nPARAMS is a plist optionally containing :cljs-repl-type (e.g. Node,\nFigwheel, etc).  All other parameters are inferred from the OTHER-REPL.\nOTHER-REPL defaults to `cider-current-repl' but in programs can also be a\nserver buffer, in which case a new session for that server is created.\n\n\\(fn PARAMS &optional OTHER-REPL)\" t nil)\n\n(autoload 'cider-connect-clj \"cider\" \"\\\nInitialize a Clojure connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port and :project-dir.  On\nprefix argument, prompt for all the parameters.\n\n\\(fn &optional PARAMS)\" t nil)\n\n(autoload 'cider-connect-cljs \"cider\" \"\\\nInitialize a ClojureScript connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port, :project-dir and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  On prefix, prompt for all the\nparameters regardless of their supplied or default values.\n\n\\(fn &optional PARAMS)\" t nil)\n\n(autoload 'cider-connect-clj&cljs \"cider\" \"\\\nInitialize a Clojure and ClojureScript connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port, :project-dir and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  When SOFT-CLJS-START is\nnon-nil, don't start if ClojureScript requirements are not met.\n\n\\(fn PARAMS &optional SOFT-CLJS-START)\" t nil)\n\n(autoload 'cider \"cider\" \"\\\nStart a connection of any type interactively.\" t nil)\n\n(defalias 'cider-jack-in #'cider-jack-in-clj)\n\n(defalias 'cider-connect #'cider-connect-clj)\n\n(with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd \"C-c M-x\") #'cider) (define-key clojure-mode-map (kbd \"C-c M-j\") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd \"C-c M-J\") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd \"C-c M-c\") #'cider-connect-clj) (define-key clojure-mode-map (kbd \"C-c M-C\") #'cider-connect-cljs) (define-key clojure-mode-map (kbd \"C-c C-x\") 'cider-start-map) (define-key clojure-mode-map (kbd \"C-c C-s\") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER))))\n\n(register-definition-prefixes \"cider\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-apropos\" \"cider-apropos.el\" (0 0 0 0))\n;;; Generated autoloads from cider-apropos.el\n\n(autoload 'cider-apropos \"cider-apropos\" \"\\\nShow all symbols whose names match QUERY, a regular expression.\nQUERY can also be a list of space-separated words (e.g. take while) which\nwill be converted to a regular expression (like take.+while) automatically\nbehind the scenes.  The search may be limited to the namespace NS, and may\noptionally search doc strings (based on DOCS-P), include private vars\n\\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).\n\n\\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)\" t nil)\n\n(autoload 'cider-apropos-documentation \"cider-apropos\" \"\\\nShortcut for (cider-apropos  nil t).\" t nil)\n\n(autoload 'cider-apropos-select \"cider-apropos\" \"\\\nSimilar to `cider-apropos', but presents the results in a completing read.\nShow all symbols whose names match QUERY, a regular expression.\nQUERY can also be a list of space-separated words (e.g. take while) which\nwill be converted to a regular expression (like take.+while) automatically\nbehind the scenes.  The search may be limited to the namespace NS, and may\noptionally search doc strings (based on DOCS-P), include private vars\n\\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).\n\n\\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)\" t nil)\n\n(autoload 'cider-apropos-documentation-select \"cider-apropos\" \"\\\nShortcut for (cider-apropos-select  nil t).\" t nil)\n\n(register-definition-prefixes \"cider-apropos\" '(\"apropos-special-form\" \"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-browse-ns\" \"cider-browse-ns.el\" (0 0\n;;;;;;  0 0))\n;;; Generated autoloads from cider-browse-ns.el\n\n(autoload 'cider-browse-ns \"cider-browse-ns\" \"\\\nList all NAMESPACE's vars in BUFFER.\n\n\\(fn NAMESPACE)\" t nil)\n\n(autoload 'cider-browse-ns-all \"cider-browse-ns\" \"\\\nList all loaded namespaces in BUFFER.\" t nil)\n\n(register-definition-prefixes \"cider-browse-ns\" '(\"cider-browse-ns-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-browse-spec\" \"cider-browse-spec.el\"\n;;;;;;  (0 0 0 0))\n;;; Generated autoloads from cider-browse-spec.el\n\n(autoload 'cider-browse-spec \"cider-browse-spec\" \"\\\nBrowse SPEC definition.\n\n\\(fn SPEC)\" t nil)\n\n(autoload 'cider-browse-spec-all \"cider-browse-spec\" \"\\\nOpen list of specs in a popup buffer.\n\nWith a prefix argument ARG, prompts for a regexp to filter specs.\nNo filter applied if the regexp is the empty string.\n\n\\(fn &optional ARG)\" t nil)\n\n(register-definition-prefixes \"cider-browse-spec\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-cheatsheet\" \"cider-cheatsheet.el\" (0\n;;;;;;  0 0 0))\n;;; Generated autoloads from cider-cheatsheet.el\n\n(autoload 'cider-cheatsheet \"cider-cheatsheet\" \"\\\nNavigate `cider-cheatsheet-hierarchy' with `completing-read'.\n\nWhen you make it to a Clojure var its doc buffer gets displayed.\" t nil)\n\n(register-definition-prefixes \"cider-cheatsheet\" '(\"cider-cheatsheet-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-classpath\" \"cider-classpath.el\" (0 0\n;;;;;;  0 0))\n;;; Generated autoloads from cider-classpath.el\n\n(autoload 'cider-classpath \"cider-classpath\" \"\\\nList all classpath entries.\" t nil)\n\n(autoload 'cider-open-classpath-entry \"cider-classpath\" \"\\\nOpen a classpath entry.\" t nil)\n\n(register-definition-prefixes \"cider-classpath\" '(\"cider-classpath-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-client\" \"cider-client.el\" (0 0 0 0))\n;;; Generated autoloads from cider-client.el\n\n(register-definition-prefixes \"cider-client\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-clojuredocs\" \"cider-clojuredocs.el\"\n;;;;;;  (0 0 0 0))\n;;; Generated autoloads from cider-clojuredocs.el\n\n(autoload 'cider-clojuredocs-web \"cider-clojuredocs\" \"\\\nOpen ClojureDocs documentation in the default web browser.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\n\n\\(fn &optional ARG)\" t nil)\n\n(autoload 'cider-clojuredocs-refresh-cache \"cider-clojuredocs\" \"\\\nRefresh the ClojureDocs cache.\" t nil)\n\n(autoload 'cider-clojuredocs \"cider-clojuredocs\" \"\\\nOpen ClojureDocs documentation in a popup buffer.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\n\n\\(fn &optional ARG)\" t nil)\n\n(register-definition-prefixes \"cider-clojuredocs\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-common\" \"cider-common.el\" (0 0 0 0))\n;;; Generated autoloads from cider-common.el\n\n(register-definition-prefixes \"cider-common\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-completion\" \"cider-completion.el\" (0\n;;;;;;  0 0 0))\n;;; Generated autoloads from cider-completion.el\n\n(register-definition-prefixes \"cider-completion\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-connection\" \"cider-connection.el\" (0\n;;;;;;  0 0 0))\n;;; Generated autoloads from cider-connection.el\n\n(defvar cider-merge-sessions nil \"\\\nControls session combination behaviour.\n\nSymbol `host' combines all sessions of a project associated with the same host.\nSymbol `project' combines all sessions of a project.\n\nAll other values do not combine any sessions.\")\n\n(custom-autoload 'cider-merge-sessions \"cider-connection\" t)\n\n(put 'cider-merge-sessions 'safe-local-variable #'symbolp)\n\n(register-definition-prefixes \"cider-connection\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-debug\" \"cider-debug.el\" (0 0 0 0))\n;;; Generated autoloads from cider-debug.el\n\n(autoload 'cider-debug-defun-at-point \"cider-debug\" \"\\\nInstrument the \\\"top-level\\\" expression at point.\nIf it is a defn, dispatch the instrumented definition.  Otherwise,\nimmediately evaluate the instrumented expression.\n\nWhile debugged code is being evaluated, the user is taken through the\nsource code and displayed the value of various expressions.  At each step,\na number of keys will be prompted to the user.\" t nil)\n\n(register-definition-prefixes \"cider-debug\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-doc\" \"cider-doc.el\" (0 0 0 0))\n;;; Generated autoloads from cider-doc.el\n\n(register-definition-prefixes \"cider-doc\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-eldoc\" \"cider-eldoc.el\" (0 0 0 0))\n;;; Generated autoloads from cider-eldoc.el\n\n(register-definition-prefixes \"cider-eldoc\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-eval\" \"cider-eval.el\" (0 0 0 0))\n;;; Generated autoloads from cider-eval.el\n\n(register-definition-prefixes \"cider-eval\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-find\" \"cider-find.el\" (0 0 0 0))\n;;; Generated autoloads from cider-find.el\n\n(autoload 'cider-find-var \"cider-find\" \"\\\nFind definition for VAR at LINE.\nPrompt according to prefix ARG and `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix of `-` or a double prefix argument causes\nthe results to be displayed in a different window.  The default value is\nthing at point.\n\n\\(fn &optional ARG VAR LINE)\" t nil)\n\n(autoload 'cider-find-dwim-at-mouse \"cider-find\" \"\\\nFind and display variable or resource at mouse EVENT.\n\n\\(fn EVENT)\" t nil)\n\n(autoload 'cider-find-dwim \"cider-find\" \"\\\nFind and display the SYMBOL-FILE at point.\nSYMBOL-FILE could be a var or a resource.  If thing at point is empty then\nshow Dired on project.  If var is not found, try to jump to resource of the\nsame name.  When called interactively, a prompt is given according to the\nvariable `cider-prompt-for-symbol'.  A single or double prefix argument\ninverts the meaning.  A prefix of `-' or a double prefix argument causes\nthe results to be displayed in a different window.  A default value of thing\nat point is given when prompted.\n\n\\(fn SYMBOL-FILE)\" t nil)\n\n(autoload 'cider-find-resource \"cider-find\" \"\\\nFind the resource at PATH.\nPrompt for input as indicated by the variable `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix argument of `-` or a double prefix\nargument causes the results to be displayed in other window.  The default\nvalue is thing at point.\n\n\\(fn PATH)\" t nil)\n\n(autoload 'cider-find-ns \"cider-find\" \"\\\nFind the file containing NS.\nA prefix ARG of `-` or a double prefix argument causes\nthe results to be displayed in a different window.\n\n\\(fn &optional ARG NS)\" t nil)\n\n(autoload 'cider-find-keyword \"cider-find\" \"\\\nFind the namespace of the keyword at point and its first occurrence there.\n\nFor instance - if the keyword at point is \\\":cider.demo/keyword\\\", this command\nwould find the namespace \\\"cider.demo\\\" and afterwards find the first mention\nof \\\"::keyword\\\" there.\n\nPrompt according to prefix ARG and `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix of `-` or a double prefix argument causes\nthe results to be displayed in a different window.  The default value is\nthing at point.\n\n\\(fn &optional ARG)\" t nil)\n\n(register-definition-prefixes \"cider-find\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-format\" \"cider-format.el\" (0 0 0 0))\n;;; Generated autoloads from cider-format.el\n\n(autoload 'cider-format-region \"cider-format\" \"\\\nFormat the Clojure code in the current region.\nSTART and END represent the region's boundaries.\n\n\\(fn START END)\" t nil)\n\n(autoload 'cider-format-defun \"cider-format\" \"\\\nFormat the code in the current defun.\" t nil)\n\n(autoload 'cider-format-buffer \"cider-format\" \"\\\nFormat the Clojure code in the current buffer.\" t nil)\n\n(autoload 'cider-format-edn-buffer \"cider-format\" \"\\\nFormat the EDN data in the current buffer.\" t nil)\n\n(autoload 'cider-format-edn-region \"cider-format\" \"\\\nFormat the EDN data in the current region.\nSTART and END represent the region's boundaries.\n\n\\(fn START END)\" t nil)\n\n(autoload 'cider-format-edn-last-sexp \"cider-format\" \"\\\nFormat the EDN data of the last sexp.\" t nil)\n\n(register-definition-prefixes \"cider-format\" '(\"cider--format-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-inspector\" \"cider-inspector.el\" (0 0\n;;;;;;  0 0))\n;;; Generated autoloads from cider-inspector.el\n\n(autoload 'cider-inspect-last-sexp \"cider-inspector\" \"\\\nInspect the result of the the expression preceding point.\" t nil)\n\n(autoload 'cider-inspect-defun-at-point \"cider-inspector\" \"\\\nInspect the result of the \\\"top-level\\\" expression at point.\" t nil)\n\n(autoload 'cider-inspect-last-result \"cider-inspector\" \"\\\nInspect the most recent eval result.\" t nil)\n\n(autoload 'cider-inspect \"cider-inspector\" \"\\\nInspect the result of the preceding sexp.\n\nWith a prefix argument ARG it inspects the result of the \\\"top-level\\\" form.\nWith a second prefix argument it prompts for an expression to eval and inspect.\n\n\\(fn &optional ARG)\" t nil)\n\n(autoload 'cider-inspect-expr \"cider-inspector\" \"\\\nEvaluate EXPR in NS and inspect its value.\nInteractively, EXPR is read from the minibuffer, and NS the\ncurrent buffer's namespace.\n\n\\(fn EXPR NS)\" t nil)\n\n(register-definition-prefixes \"cider-inspector\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-jar\" \"cider-jar.el\" (0 0 0 0))\n;;; Generated autoloads from cider-jar.el\n\n(register-definition-prefixes \"cider-jar\" '(\"cider-jar-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-macroexpansion\" \"cider-macroexpansion.el\"\n;;;;;;  (0 0 0 0))\n;;; Generated autoloads from cider-macroexpansion.el\n\n(autoload 'cider-macroexpand-1 \"cider-macroexpansion\" \"\\\nInvoke \\\\=`macroexpand-1\\\\=` on the expression preceding point.\nIf invoked with a PREFIX argument, use \\\\=`macroexpand\\\\=` instead of\n\\\\=`macroexpand-1\\\\=`.\n\n\\(fn &optional PREFIX)\" t nil)\n\n(autoload 'cider-macroexpand-all \"cider-macroexpansion\" \"\\\nInvoke \\\\=`macroexpand-all\\\\=` on the expression preceding point.\" t nil)\n\n(register-definition-prefixes \"cider-macroexpansion\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-mode\" \"cider-mode.el\" (0 0 0 0))\n;;; Generated autoloads from cider-mode.el\n\n(defvar cider-mode-line '(:eval (format \" cider[%s]\" (cider--modeline-info))) \"\\\nMode line lighter for cider mode.\n\nThe value of this variable is a mode line template as in\n`mode-line-format'.  See Info Node `(elisp)Mode Line Format' for details\nabout mode line templates.\n\nCustomize this variable to change how cider mode displays its status in the\nmode line.  The default value displays the current connection.  Set this\nvariable to nil to disable the mode line entirely.\")\n\n(custom-autoload 'cider-mode-line \"cider-mode\" t)\n\n(with-eval-after-load 'clojure-mode (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map \"Menu for Clojure mode.\\n  This is displayed in `clojure-mode' buffers, if `cider-mode' is not active.\" `(\"CIDER\" :visible (not cider-mode) [\"Start a Clojure REPL\" cider-jack-in-clj :help \"Starts an nREPL server and connects a Clojure REPL to it.\"] [\"Connect to a Clojure REPL\" cider-connect-clj :help \"Connects to a REPL that's already running.\"] [\"Start a ClojureScript REPL\" cider-jack-in-cljs :help \"Starts an nREPL server and connects a ClojureScript REPL to it.\"] [\"Connect to a ClojureScript REPL\" cider-connect-cljs :help \"Connects to a ClojureScript REPL that's already running.\"] [\"Start a Clojure REPL, and a ClojureScript REPL\" cider-jack-in-clj&cljs :help \"Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.\"] \"--\" [\"View user manual\" cider-view-manual])))\n\n(autoload 'cider-mode \"cider-mode\" \"\\\nMinor mode for REPL interaction from a Clojure buffer.\n\nThis is a minor mode.  If called interactively, toggle the `Cider\nmode' mode.  If the prefix argument is positive, enable the mode,\nand if it is zero or negative, disable the mode.\n\nIf called from Lisp, toggle the mode if ARG is `toggle'.  Enable\nthe mode if ARG is nil, omitted, or is a positive number.\nDisable the mode if ARG is a negative number.\n\nTo check whether the minor mode is enabled in the current buffer,\nevaluate `cider-mode'.\n\nThe mode's hook is called both when the mode is enabled and when\nit is disabled.\n\n\\\\{cider-mode-map}\n\n\\(fn &optional ARG)\" t nil)\n\n(register-definition-prefixes \"cider-mode\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-ns\" \"cider-ns.el\" (0 0 0 0))\n;;; Generated autoloads from cider-ns.el\n\n(autoload 'cider-ns-reload \"cider-ns\" \"\\\nSend a (require 'ns :reload) to the REPL.\n\nWith an argument PROMPT, it prompts for a namespace name.  This is the\nClojure out of the box reloading experience and does not rely on\norg.clojure/tools.namespace.  See Commentary of this file for a longer list\nof differences.  From the Clojure doc: \\\":reload forces loading of all the\nidentified libs even if they are already loaded\\\".\n\n\\(fn &optional PROMPT)\" t nil)\n\n(autoload 'cider-ns-reload-all \"cider-ns\" \"\\\nSend a (require 'ns :reload-all) to the REPL.\n\nWith an argument PROMPT, it prompts for a namespace name.  This is the\nClojure out of the box reloading experience and does not rely on\norg.clojure/tools.namespace.  See Commentary of this file for a longer list\nof differences.  From the Clojure doc: \\\":reload-all implies :reload and\nalso forces loading of all libs that the identified libs directly or\nindirectly load via require\\\".\n\n\\(fn &optional PROMPT)\" t nil)\n\n(autoload 'cider-ns-refresh \"cider-ns\" \"\\\nReload modified and unloaded namespaces on the classpath.\n\nWith a single prefix argument, or if MODE is `refresh-all', reload all\nnamespaces on the classpath unconditionally.\n\nWith a double prefix argument, or if MODE is `clear', clear the state of\nthe namespace tracker before reloading.  This is useful for recovering from\nsome classes of error (for example, those caused by circular dependencies)\nthat a normal reload would not otherwise recover from.  The trade-off of\nclearing is that stale code from any deleted files may not be completely\nunloaded.\n\nWith a negative prefix argument, or if MODE is `inhibit-fns', prevent any\nrefresh functions (defined in `cider-ns-refresh-before-fn' and\n`cider-ns-refresh-after-fn') from being invoked.\n\n\\(fn &optional MODE)\" t nil)\n\n(register-definition-prefixes \"cider-ns\" '(\"cider-ns-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-overlays\" \"cider-overlays.el\" (0 0 0\n;;;;;;  0))\n;;; Generated autoloads from cider-overlays.el\n\n(register-definition-prefixes \"cider-overlays\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-popup\" \"cider-popup.el\" (0 0 0 0))\n;;; Generated autoloads from cider-popup.el\n\n(register-definition-prefixes \"cider-popup\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-profile\" \"cider-profile.el\" (0 0 0 0))\n;;; Generated autoloads from cider-profile.el\n\n(autoload 'cider-profile-samples \"cider-profile\" \"\\\nDisplays current max-sample-count.\nIf optional QUERY is specified, set max-sample-count and display new value.\n\n\\(fn &optional QUERY)\" t nil)\n\n(autoload 'cider-profile-var-profiled-p \"cider-profile\" \"\\\nDisplays the profiling status of var under point.\nPrompts for var if none under point or QUERY is present.\n\n\\(fn QUERY)\" t nil)\n\n(autoload 'cider-profile-ns-toggle \"cider-profile\" \"\\\nToggle profiling for the ns associated with optional QUERY.\n\nIf optional argument QUERY is non-nil, prompt for ns.  Otherwise use\ncurrent ns.\n\n\\(fn &optional QUERY)\" t nil)\n\n(autoload 'cider-profile-toggle \"cider-profile\" \"\\\nToggle profiling for the given QUERY.\nDefaults to the symbol at point.\nWith prefix arg or no symbol at point, prompts for a var.\n\n\\(fn QUERY)\" t nil)\n\n(autoload 'cider-profile-summary \"cider-profile\" \"\\\nDisplay a summary of currently collected profile data.\" t nil)\n\n(autoload 'cider-profile-var-summary \"cider-profile\" \"\\\nDisplay profile data for var under point QUERY.\nDefaults to the symbol at point.  With prefix arg or no symbol at point,\nprompts for a var.\n\n\\(fn QUERY)\" t nil)\n\n(autoload 'cider-profile-clear \"cider-profile\" \"\\\nClear any collected profile data.\" t nil)\n\n(register-definition-prefixes \"cider-profile\" '(\"cider-profile-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-repl\" \"cider-repl.el\" (0 0 0 0))\n;;; Generated autoloads from cider-repl.el\n\n(register-definition-prefixes \"cider-repl\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-repl-history\" \"cider-repl-history.el\"\n;;;;;;  (0 0 0 0))\n;;; Generated autoloads from cider-repl-history.el\n\n(autoload 'cider-repl-history \"cider-repl-history\" \"\\\nDisplay items in the CIDER command history in another buffer.\" t nil)\n\n(register-definition-prefixes \"cider-repl-history\" '(\"cider-repl-history-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-resolve\" \"cider-resolve.el\" (0 0 0 0))\n;;; Generated autoloads from cider-resolve.el\n\n(register-definition-prefixes \"cider-resolve\" '(\"cider-resolve-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-scratch\" \"cider-scratch.el\" (0 0 0 0))\n;;; Generated autoloads from cider-scratch.el\n\n(autoload 'cider-scratch \"cider-scratch\" \"\\\nGo to the scratch buffer named `cider-scratch-buffer-name'.\" t nil)\n\n(register-definition-prefixes \"cider-scratch\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-selector\" \"cider-selector.el\" (0 0 0\n;;;;;;  0))\n;;; Generated autoloads from cider-selector.el\n\n(autoload 'cider-selector \"cider-selector\" \"\\\nSelect a new buffer by type, indicated by a single character.\nThe user is prompted for a single character indicating the method by\nwhich to choose a new buffer.  The `?' character describes the\navailable methods.  OTHER-WINDOW provides an optional target.\nSee `def-cider-selector-method' for defining new methods.\n\n\\(fn &optional OTHER-WINDOW)\" t nil)\n\n(register-definition-prefixes \"cider-selector\" '(\"??\" \"?c\" \"?d\" \"?e\" \"?m\" \"?p\" \"?q\" \"?r\" \"?s\" \"?x\" \"cider-selector-\" \"def-cider-selector-method\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-stacktrace\" \"cider-stacktrace.el\" (0\n;;;;;;  0 0 0))\n;;; Generated autoloads from cider-stacktrace.el\n\n(register-definition-prefixes \"cider-stacktrace\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-test\" \"cider-test.el\" (0 0 0 0))\n;;; Generated autoloads from cider-test.el\n\n(defvar cider-auto-test-mode nil \"\\\nNon-nil if Cider-Auto-Test mode is enabled.\nSee the `cider-auto-test-mode' command\nfor a description of this minor mode.\nSetting this variable directly does not take effect;\neither customize it (see the info node `Easy Customization')\nor call the function `cider-auto-test-mode'.\")\n\n(custom-autoload 'cider-auto-test-mode \"cider-test\" nil)\n\n(autoload 'cider-auto-test-mode \"cider-test\" \"\\\nToggle automatic testing of Clojure files.\n\nThis is a minor mode.  If called interactively, toggle the\n`Cider-Auto-Test mode' mode.  If the prefix argument is positive,\nenable the mode, and if it is zero or negative, disable the mode.\n\nIf called from Lisp, toggle the mode if ARG is `toggle'.  Enable\nthe mode if ARG is nil, omitted, or is a positive number.\nDisable the mode if ARG is a negative number.\n\nTo check whether the minor mode is enabled in the current buffer,\nevaluate `(default-value \\\\='cider-auto-test-mode)'.\n\nThe mode's hook is called both when the mode is enabled and when\nit is disabled.\n\nWhen enabled this reruns tests every time a Clojure file is loaded.\nOnly runs tests corresponding to the loaded file's namespace and does\nnothing if no tests are defined or if the file failed to load.\n\n\\(fn &optional ARG)\" t nil)\n\n(register-definition-prefixes \"cider-test\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-tracing\" \"cider-tracing.el\" (0 0 0 0))\n;;; Generated autoloads from cider-tracing.el\n\n(autoload 'cider-toggle-trace-var \"cider-tracing\" \"\\\nToggle var tracing.\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\n\n\\(fn ARG)\" t nil)\n\n(autoload 'cider-toggle-trace-ns \"cider-tracing\" \"\\\nToggle ns tracing.\nDefaults to the current ns.  With prefix arg QUERY, prompts for a ns.\n\n\\(fn QUERY)\" t nil)\n\n(register-definition-prefixes \"cider-tracing\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-util\" \"cider-util.el\" (0 0 0 0))\n;;; Generated autoloads from cider-util.el\n\n(autoload 'cider-view-manual \"cider-util\" \"\\\nView the manual in your default browser.\" t nil)\n\n(register-definition-prefixes \"cider-util\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"cider-xref\" \"cider-xref.el\" (0 0 0 0))\n;;; Generated autoloads from cider-xref.el\n\n(autoload 'cider-xref-fn-refs \"cider-xref\" \"\\\nShow all functions that reference the var matching NS and SYMBOL.\n\n\\(fn &optional NS SYMBOL)\" t nil)\n\n(autoload 'cider-xref-fn-deps \"cider-xref\" \"\\\nShow all functions referenced by the var matching NS and SYMBOL.\n\n\\(fn &optional NS SYMBOL)\" t nil)\n\n(autoload 'cider-xref-fn-refs-select \"cider-xref\" \"\\\nDisplays the references for NS and SYMBOL using completing read.\n\n\\(fn &optional NS SYMBOL)\" t nil)\n\n(autoload 'cider-xref-fn-deps-select \"cider-xref\" \"\\\nDisplays the function dependencies for  NS and SYMBOL using completing read.\n\n\\(fn &optional NS SYMBOL)\" t nil)\n\n(register-definition-prefixes \"cider-xref\" '(\"cider-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"nrepl-client\" \"nrepl-client.el\" (0 0 0 0))\n;;; Generated autoloads from nrepl-client.el\n\n(register-definition-prefixes \"nrepl-client\" '(\"cider-enlighten-mode\" \"emacs-bug-46284/when-27.1-windows-nt\" \"nrepl-\"))\n\n;;;***\n\f\n;;;### (autoloads nil \"nrepl-dict\" \"nrepl-dict.el\" (0 0 0 0))\n;;; Generated autoloads from nrepl-dict.el\n\n(register-definition-prefixes \"nrepl-dict\" '(\"nrepl-\"))\n\n;;;***\n\f\n;;;### (autoloads nil nil (\"cider-pkg.el\") (0 0 0 0))\n\n;;;***\n\f\n;; Local Variables:\n;; version-control: never\n;; no-byte-compile: t\n;; no-update-autoloads: t\n;; coding: utf-8\n;; End:\n;;; cider-autoloads.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-browse-ns.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53583646,"end":53583688},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53583688},"to":{"change":3,"start":53562044,"end":53562044},"introduced_by":3}],"inode":{"change":3,"pos":53562044}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53562044},"to":{"change":3,"start":53562045,"end":53583645},"introduced_by":3}],"inode":{"change":3,"pos":53562044}},"content":[{"Del":";;; cider-browse-ns.el --- CIDER namespace browser  -*- lexical-binding: t; -*-\n\n;; Copyright © 2014-2022 John Andrews, Bozhidar Batsov and CIDER contributors\n\n;; Author: John Andrews \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; M-x cider-browse-ns\n;;\n;; Display a list of all vars in a namespace.\n;; Pressing  will take you to the cider-doc buffer for that var.\n;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode').\n\n;; M-x cider-browse-ns-all\n;;\n;; Explore Clojure namespaces by browsing a list of all namespaces.\n;; Pressing  expands into a list of that namespace's vars as if by\n;; executing the command (cider-browse-ns \"my.ns\").\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'cider-util)\n(require 'nrepl-dict)\n\n(require 'subr-x)\n(require 'easymenu)\n(require 'button)\n(require 'cl-lib)\n(require 'thingatpt)\n\n\n(defgroup cider-browse-ns nil\n  \"Display contents of namespaces for CIDER.\"\n  :prefix \"cider-browse-ns-\"\n  :group 'cider)\n\n(defface cider-browse-ns-extra-info-face\n  '((t (:inherit shadow)))\n  \"Face for displaying extra info of namespace vars.\"\n  :package-version '(cider . \"1.4.0\"))\n\n(defcustom cider-browse-ns-default-filters nil\n  \"List of default hide filters to apply to browse-ns buffer.\n\nAvailable options include `private', `test', `macro', `function', and\n`var'.\"\n  :type 'list\n  :package-version '(cider . \"1.4.0\"))\n\n(defconst cider-browse-ns-buffer \"*cider-ns-browser*\")\n\n(defvar-local cider-browse-ns-current-ns nil)\n\n(defvar-local cider-browse-ns-filters nil)\n(defvar-local cider-browse-ns-show-all nil)\n(defvar-local cider-browse-ns-group-by nil)\n(defvar-local cider-browse-ns-items nil)\n(defvar-local cider-browse-ns-title nil)\n(defvar-local cider-browse-ns-group-by nil)\n\n\n;; Mode Definition\n\n(defvar cider-browse-ns-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map cider-popup-buffer-mode-map)\n    (define-key map \"d\" #'cider-browse-ns-doc-at-point)\n    (define-key map \"s\" #'cider-browse-ns-find-at-point)\n    (define-key map (kbd \"RET\") #'cider-browse-ns-operate-at-point)\n    (define-key map \"^\" #'cider-browse-ns-all)\n    (define-key map \"n\" #'next-line)\n    (define-key map \"p\" #'previous-line)\n\n    (define-key map \"a\" #'cider-browse-ns-toggle-all)\n\n    (define-key map (kbd \"h p\") #'cider-browse-ns-toggle-hide-private)\n    (define-key map (kbd \"h t\") #'cider-browse-ns-toggle-hide-test)\n    (define-key map (kbd \"h m\") #'cider-browse-ns-toggle-hide-macro)\n    (define-key map (kbd \"h f\") #'cider-browse-ns-toggle-hide-function)\n    (define-key map (kbd \"h v\") #'cider-browse-ns-toggle-hide-var)\n\n    (define-key map (kbd \"g t\") #'cider-browse-ns-group-by-type)\n    (define-key map (kbd \"g v\") #'cider-browse-ns-group-by-visibility)\n\n    (easy-menu-define cider-browse-ns-mode-menu map\n      \"Menu for CIDER's namespace browser\"\n      '(\"Namespace Browser\"\n        [\"Show doc\" cider-browse-ns-doc-at-point]\n        [\"Go to definition\" cider-browse-ns-find-at-point]\n        \"--\"\n        [\"Browse all namespaces\" cider-browse-ns-all]))\n    map))\n\n(defvar cider-browse-ns-mouse-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map [mouse-1] #'cider-browse-ns-handle-mouse)\n    map))\n\n(define-derived-mode cider-browse-ns-mode special-mode \"browse-ns\"\n  \"Major mode for browsing Clojure namespaces.\n\n\\\\{cider-browse-ns-mode-map}\"\n  (setq-local electric-indent-chars nil)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t))\n  (setq-local cider-browse-ns-current-ns nil))\n\n(defun cider-browse-ns--text-face (var-meta)\n  \"Return font-lock-face for a var.\nVAR-META contains the metadata information used to decide a face.\nPresence of \\\"arglists\\\" and \\\"macro\\\" indicates a macro form.\nOnly \\\"arglists\\\" indicates a function. Otherwise, its a variable.\nIf the NAMESPACE is not loaded in the REPL, assume TEXT is a fn.\"\n  (cond\n   ((not var-meta) 'font-lock-function-name-face)\n   ((and (nrepl-dict-contains var-meta \"arglists\")\n         (string= (nrepl-dict-get var-meta \"macro\") \"true\"))\n    'font-lock-keyword-face)\n   ((nrepl-dict-contains var-meta \"arglists\") 'font-lock-function-name-face)\n   (t 'font-lock-variable-name-face)))\n\n(defun cider-browse-ns--properties (var var-meta)\n  \"Decorate VAR with a clickable keymap and a face.\nVAR-META is used to decide a font-lock face.\"\n  (let ((face (cider-browse-ns--text-face var-meta)))\n    (propertize var\n                'font-lock-face face\n                'mouse-face 'highlight\n                'keymap cider-browse-ns-mouse-map)))\n\n(defun cider-browse-ns--ns-list (buffer title nss)\n  \"List the namespaces NSS in BUFFER.\n\nBuffer is rendered with TITLE at the top and lists ITEMS filtered according\nto user settings.\"\n  (let ((dict (nrepl-dict)))\n    (dolist (ns nss)\n      (nrepl-dict-put dict ns (nrepl-dict \"ns\" \"true\")))\n    (cider-browse-ns--list buffer title dict nil)))\n\n(defun cider-browse-ns--list (buffer title items ns)\n  \"Initialize rendering of browse-ns BUFFER.\n\nInitialize the buffer's TITLE, namespace NS, and the nrepl-dict ITEMS to be\ndisplayed.\"\n  (with-current-buffer buffer\n    (cider-browse-ns-mode)\n    (setq-local cider-browse-ns-items items)\n    (setq-local cider-browse-ns-title title)\n    (setq-local cider-browse-ns-filters cider-browse-ns-default-filters)\n    (setq-local cider-browse-ns-current-ns ns))\n  (cider-browse-ns--render-buffer))\n\n(defun cider-browse-ns--meta-macro-p (var-meta)\n  \"Return non-nil if VAR-META is the metadata of a macro.\"\n  (and (nrepl-dict-contains var-meta \"arglists\")\n       (string= (nrepl-dict-get var-meta \"macro\") \"true\")))\n\n(defun cider-browse-ns--meta-test-p (var-meta)\n  \"Return non-nil if VAR-META is the metadata of a test.\"\n  (nrepl-dict-contains var-meta \"test\"))\n\n(defun cider-browse-ns--meta-function-p (var-meta)\n  \"Return non-nil if VAR-META is the metadata of a function.\"\n  (and (nrepl-dict-contains var-meta \"arglists\")\n       (not (cider-browse-ns--meta-macro-p var-meta))))\n\n(defun cider-browse-ns--meta-private-p (var-meta)\n  \"Return non-nil if VAR-META indicates a private element.\"\n  (string= (nrepl-dict-get var-meta \"private\") \"true\"))\n\n(defun cider-browse-ns--meta-var-p (var-meta)\n  \"Return non-nil if VAR-META indicates a var.\"\n  (not (or (cider-browse-ns--meta-test-p var-meta)\n           (cider-browse-ns--meta-macro-p var-meta)\n           (cider-browse-ns--meta-function-p var-meta))))\n\n(defun cider-browse-ns--item-filter (_ var-meta)\n  \"Return non-nil if item containing VAR-META should be listed in buffer.\"\n  (let ((function-filter-p (memq 'function cider-browse-ns-filters))\n        (var-filter-p (memq 'var cider-browse-ns-filters))\n        (private-filter-p (memq 'private cider-browse-ns-filters))\n        (test-filter-p (memq 'test cider-browse-ns-filters))\n        (macro-filter-p (memq 'macro cider-browse-ns-filters)))\n    ;; check if item should be displayed\n    (let* ((macro-p (cider-browse-ns--meta-macro-p var-meta))\n           (function-p (cider-browse-ns--meta-function-p var-meta))\n           (private-p (cider-browse-ns--meta-private-p var-meta))\n           (test-p (cider-browse-ns--meta-test-p var-meta))\n           (var-p (cider-browse-ns--meta-var-p var-meta)))\n      (or cider-browse-ns-show-all\n          (not (or (and macro-p macro-filter-p)\n                   (and function-p function-filter-p)\n                   (and test-p test-filter-p)\n                   (and var-p var-filter-p)\n                   (and private-p private-filter-p)))))))\n\n(defun cider-browse-ns--propertized-item (key items)\n  \"Return propertized line of item KEY in nrepl-dict ITEMS.\"\n  (let* ((var-meta (nrepl-dict-get items key))\n         (face (cider-browse-ns--text-face (nrepl-dict-get items key)))\n         (private-p (string= (nrepl-dict-get var-meta \"private\") \"true\"))\n         (test-p (nrepl-dict-contains var-meta \"test\"))\n         (ns-p (nrepl-dict-contains var-meta \"ns\")))\n    (concat\n     (propertize key\n                 'font-lock-face face\n                 'ns ns-p)\n     \" \"\n     (cond\n      (test-p (propertize \"(test) \" 'face 'cider-browse-ns-extra-info-face))\n      (private-p (propertize \"(-) \" 'face 'cider-browse-ns-extra-info-face))\n      (t \"\")))))\n\n(defun cider-browse-ns--display-list (keys items max-length &optional label)\n  \"Render the items of KEYS as condained in the nrepl-dict ITEMS.\n\nPad the row to be MAX-LENGTH+1.  If LABEL is non-nil, add a header to the\nlist of items.\"\n  (when keys\n    (when label\n      (insert \"  \" label \":\\n\"))\n    (dolist (key keys)\n      (let* ((doc (nrepl-dict-get-in items (list key \"doc\")))\n             (doc (when doc (read doc)))\n             (first-doc-line (cider-browse-ns--first-doc-line doc))\n             (item-line (cider-browse-ns--propertized-item key items)))\n        (insert \"  \")\n        (insert item-line)\n        (when cider-browse-ns-current-ns\n          (insert (make-string (+ (- max-length (string-width item-line)) 1) ?·))\n          (insert \" \" (propertize first-doc-line 'font-lock-face 'font-lock-doc-face)))\n        (insert \"\\n\")))\n    (insert \"\\n\")))\n\n(defun cider-browse-ns--column-width (items)\n  \"Determine the display width of displayed ITEMS.\"\n  (let* ((propertized-lines\n          (seq-map (lambda (key)\n                     (cider-browse-ns--propertized-item key items))\n                   (nrepl-dict-keys items))))\n    (if propertized-lines\n        (apply #'max (seq-map (lambda (entry) (string-width entry))\n                              propertized-lines))\n      0)))\n\n(defun cider-browse-ns--render-items (items)\n  \"Render the nrepl-dict ITEMS to the browse-ns buffer.\"\n  (let* ((max-length (cider-browse-ns--column-width items)))\n    (cl-labels\n        ((keys-from-pred\n          (pred items)\n          (nrepl-dict-keys (nrepl-dict-filter (lambda (_ var-meta)\n                                                (funcall pred var-meta))\n                                              items))))\n      (cond\n       ((eql cider-browse-ns-group-by 'type)\n        (let* ((func-keys (keys-from-pred #'cider-browse-ns--meta-function-p items))\n               (macro-keys (keys-from-pred #'cider-browse-ns--meta-macro-p items))\n               (var-keys (keys-from-pred #'cider-browse-ns--meta-var-p items))\n               (test-keys (keys-from-pred #'cider-browse-ns--meta-test-p items)))\n          (cider-browse-ns--display-list func-keys items max-length \"Functions\")\n          (cider-browse-ns--display-list macro-keys items max-length \"Macros\")\n          (cider-browse-ns--display-list var-keys items max-length \"Vars\")\n          (cider-browse-ns--display-list test-keys items max-length \"Tests\")))\n       ((eql cider-browse-ns-group-by 'visibility)\n        (let* ((public-keys\n                (keys-from-pred\n                 (lambda (var-meta)\n                   (not (cider-browse-ns--meta-private-p var-meta)))\n                 items))\n               (private-keys (keys-from-pred #'cider-browse-ns--meta-private-p items)))\n          (cider-browse-ns--display-list public-keys items max-length \"Public\")\n          (cider-browse-ns--display-list private-keys items max-length \"Private\")))\n       (t\n        (cider-browse-ns--display-list\n         (nrepl-dict-keys items) items max-length))))))\n\n(defun cider-browse-ns--filter (flag)\n  \"Toggle the filter indicated by FLAG and re-render the buffer.\"\n  (setq cider-browse-ns-filters\n        (if (memq flag cider-browse-ns-filters)\n            (remq flag cider-browse-ns-filters)\n          (cons flag cider-browse-ns-filters)))\n  (cider-browse-ns--render-buffer))\n\n(defun cider-browse-ns--button-filter (button)\n  \"Handle filter action for BUTTON.\"\n  (let ((flag (button-get button 'filter)))\n    (cider-browse-ns--filter flag)))\n\n(defun cider-browse-ns--group (flag)\n  \"Set the group-by option to FLAG and re-renderthe buffer.\"\n  (setq cider-browse-ns-group-by\n        (if (eql flag cider-browse-ns-group-by) nil flag))\n  (cider-browse-ns--render-buffer))\n\n(defun cider-browse-ns--button-group (button)\n  \"Handle grouping action for BUTTON.\"\n  (let ((flag (button-get button 'group-by)))\n    (cider-browse-ns--group flag)))\n\n(defun cider-browse-ns--toggle-all (_button)\n  \"Toggle the display-all visibility setting.\"\n  (setq cider-browse-ns-show-all (not cider-browse-ns-show-all))\n  (cider-browse-ns--render-buffer))\n\n(defun cider-browse-ns--render-header (&optional filtered-items-ct)\n  \"Render the section at the top of the buffer displaying visibility controls.\n\nIf FILTERED-ITEMS-CT is non-nil, then display a message of how many items\nare being filtered.\"\n  ;; Display Show line\n  (insert \"  Show: \")\n  (insert-text-button \"All\"\n                      'follow-link t\n                      'action #'cider-browse-ns--toggle-all\n                      ;; 'help-echo (cider-stacktrace-tooltip)\n                      'face (if cider-browse-ns-show-all\n                                'cider-stacktrace-filter-active-face\n                              nil))\n  (insert \"\\n\")\n  ;; Display Filters\n  (let ((filters '((\"Private\" private)\n                   (\"Test\" test)\n                   (\"Macro\" macro)\n                   (\"Function\" function)\n                   (\"Var\" var))))\n    (insert \"  Hide: \")\n    (dolist (filter filters)\n      (seq-let (title key) filter\n        (let ((is-active (memq key cider-browse-ns-filters)))\n          (insert-text-button title\n                              'filter key\n                              'follow-link t\n                              'action #'cider-browse-ns--button-filter\n                              ;; 'help-echo (cider-stacktrace-tooltip)\n                              'face (if (and is-active (not cider-browse-ns-show-all))\n                                        'cider-stacktrace-filter-active-face\n                                      nil))\n          (insert \" \"))))\n    (when filtered-items-ct\n      (insert (format \"(%d items filtered)\" filtered-items-ct))))\n  (insert \"\\n\")\n  ;; Groupings\n  (insert \"  Group-by: \")\n  (let ((groupings '((\"Type\" type)\n                     (\"Visibility\" visibility))))\n    (dolist (grouping groupings)\n      (seq-let (title key) grouping\n        (let ((is-active (eql key cider-browse-ns-group-by)))\n          (insert-text-button title\n                              'group-by key\n                              'follow-link t\n                              'action #'cider-browse-ns--button-group\n                              ;; 'help-echo ()\n                              'face (if is-active\n                                        'cider-stacktrace-filter-active-face\n                                      nil)))\n        (insert \" \"))))\n  (insert \"\\n\\n\"))\n\n(defun cider-browse-ns--render-buffer (&optional buffer)\n  \"Render the sections of the browse-ns buffer.\n\nRender occurs in BUFFER if non-nil.  This function is the main entrypoint\nfor redisplaying the buffer when filters change.\"\n  (with-current-buffer (or buffer (current-buffer))\n    (let* ((inhibit-read-only t)\n           (point (point))\n           (filtered-items (nrepl-dict-filter #'cider-browse-ns--item-filter\n                                              cider-browse-ns-items))\n           (filtered-item-ct (- (length (nrepl-dict-keys cider-browse-ns-items))\n                                (length (nrepl-dict-keys filtered-items)))))\n      (erase-buffer)\n      (insert (propertize (cider-propertize cider-browse-ns-title 'ns) 'ns t) \"\\n\")\n      (when cider-browse-ns-current-ns\n        (cider-browse-ns--render-header filtered-item-ct))\n      (cider-browse-ns--render-items filtered-items)\n      (goto-char point))))\n\n(defun cider-browse-ns--first-doc-line (doc)\n  \"Return the first line of the given DOC string.\nIf the first line of the DOC string contains multiple sentences, only\nthe first sentence is returned.  If the DOC string is nil, a Not documented\nstring is returned.\"\n  (if doc\n      (let* ((split-newline (split-string doc \"\\n\"))\n             (first-line (car split-newline)))\n        (cond\n         ((string-match \"\\\\. \" first-line) (substring first-line 0 (match-end 0)))\n         ((= 1 (length split-newline)) first-line)\n         (t (concat first-line \"...\"))))\n    \"Not documented.\"))\n\n(defun cider-browse-ns--combined-vars-with-meta (namespace)\n  \"Return the combined public and private vars in NAMESPACE.\n\nPrivate vars have the additional metadata \\\"private\\\": \\\"true\\\" in their\nvar-meta map.\"\n  (let ((items (cider-sync-request:ns-vars-with-meta namespace))\n        (private-items (cider-sync-request:private-ns-vars-with-meta namespace)))\n    (when private-items\n      (dolist (key (nrepl-dict-keys private-items))\n        (let ((var-meta (nrepl-dict-put (nrepl-dict-get private-items key)\n                                        \"private\" \"true\")))\n          (setq items (nrepl-dict-put items key var-meta)))))\n    items))\n\n;; Interactive Functions\n\n;;;###autoload\n(defun cider-browse-ns (namespace)\n  \"List all NAMESPACE's vars in BUFFER.\"\n  (interactive (list (completing-read \"Browse namespace: \" (cider-sync-request:ns-list))))\n  (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)\n    (cider-browse-ns--list (current-buffer)\n                           namespace\n                           (cider-browse-ns--combined-vars-with-meta namespace)\n                           namespace)))\n\n;;;###autoload\n(defun cider-browse-ns-all ()\n  \"List all loaded namespaces in BUFFER.\"\n  (interactive)\n  (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)\n    (let ((names (cider-sync-request:ns-list)))\n      (cider-browse-ns--ns-list\n       (current-buffer)\n       \"All loaded namespaces\"\n       (mapcar (lambda (name)\n                 (cider-browse-ns--properties name nil))\n               names)))))\n\n(defun cider-browse-ns--thing-at-point ()\n  \"Get the thing at point.\nReturn a list of the type ('ns or 'var) and the value.\"\n  (let ((ns-p (get-text-property (point) 'ns))\n        (line (car (split-string (string-trim (thing-at-point 'line)) \" \"))))\n    (if (or ns-p (string-match \"\\\\.\" line))\n        `(ns ,line)\n      `(var ,(format \"%s/%s\"\n                     (or (get-text-property (point) 'cider-browse-ns-current-ns)\n                         cider-browse-ns-current-ns)\n                     line)))))\n\n(defun cider-browse-ns-toggle-all ()\n  \"Toggle showing all of the items in the browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--toggle-all nil))\n\n(defun cider-browse-ns-toggle-hide-private ()\n  \"Toggle visibility of private items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--filter 'private))\n\n(defun cider-browse-ns-toggle-hide-test ()\n  \"Toggle visibility of test items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--filter 'test))\n\n(defun cider-browse-ns-toggle-hide-macro ()\n  \"Toggle visibility of macro items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--filter 'macro))\n\n(defun cider-browse-ns-toggle-hide-function ()\n  \"Toggle visibility of function items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--filter 'function))\n\n(defun cider-browse-ns-toggle-hide-var ()\n  \"Toggle visibility of var items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--filter 'var))\n\n(defun cider-browse-ns-group-by-type ()\n  \"Toggle visibility of var items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--group 'type))\n\n(defun cider-browse-ns-group-by-visibility ()\n  \"Toggle visibility of var items displayed in browse-ns buffer.\"\n  (interactive)\n  (cider-browse-ns--group 'visibility))\n\n\n(declare-function cider-doc-lookup \"cider-doc\")\n\n(defun cider-browse-ns-doc-at-point ()\n  \"Show the documentation for the thing at current point.\"\n  (interactive)\n  (let* ((thing (cider-browse-ns--thing-at-point))\n         (value (cadr thing)))\n    ;; value is either some ns or a var\n    (cider-doc-lookup value)))\n\n(defun cider-browse-ns-operate-at-point ()\n  \"Expand browser according to thing at current point.\nIf the thing at point is a ns it will be browsed,\nand if the thing at point is some var - its documentation will\nbe displayed.\"\n  (interactive)\n  (let* ((thing (cider-browse-ns--thing-at-point))\n         (type (car thing))\n         (value (cadr thing)))\n    (if (eq type 'ns)\n        (cider-browse-ns value)\n      (cider-doc-lookup value))))\n\n(declare-function cider-find-ns \"cider-find\")\n(declare-function cider-find-var \"cider-find\")\n\n(defun cider-browse-ns-find-at-point ()\n  \"Find the definition of the thing at point.\"\n  (interactive)\n  (let* ((thing (cider-browse-ns--thing-at-point))\n         (type (car thing))\n         (value (cadr thing)))\n    (if (eq type 'ns)\n        (cider-find-ns nil value)\n      (cider-find-var current-prefix-arg value))))\n\n(defun cider-browse-ns-handle-mouse (_event)\n  \"Handle mouse click EVENT.\"\n  (interactive \"e\")\n  (cider-browse-ns-operate-at-point))\n\n(provide 'cider-browse-ns)\n\n;;; cider-browse-ns.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-browse-spec.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53561998,"end":53562042},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53562042},"to":{"change":3,"start":53542373,"end":53542373},"introduced_by":3}],"inode":{"change":3,"pos":53542373}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53542373},"to":{"change":3,"start":53542374,"end":53561997},"introduced_by":3}],"inode":{"change":3,"pos":53542373}},"content":[{"Del":";;; cider-browse-spec.el --- CIDER spec browser  -*- lexical-binding: t; -*-\n\n;; Copyright © 2017-2022 Juan Monetta, Bozhidar Batsov and CIDER contributors\n\n;; Author: Juan Monetta \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; M-x cider-browse-spec\n;;\n;; Display a spec description you can browse.\n;; Pressing  over a sub spec will take you to the description of that sub spec.\n;; Pressing ^ takes you to the list of all specs.\n\n;; M-x cider-browse-spec-all\n;;\n;; Explore clojure.spec registry by browsing a list of all specs.\n;; Pressing  over a spec display the spec description you can browse.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'cider-util)\n(require 'cl-lib)\n(require 'nrepl-dict)\n(require 'seq)\n(require 'subr-x)\n(require 'help-mode)\n\n;; The buffer names used by the spec browser\n(defconst cider-browse-spec-buffer \"*cider-spec-browser*\")\n(defconst cider-browse-spec-example-buffer \"*cider-spec-example*\")\n\n;; Mode Definition\n\n(defvar cider-browse-spec-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map (make-composed-keymap button-buffer-map\n                                                 cider-popup-buffer-mode-map))\n    (define-key map (kbd \"RET\") #'cider-browse-spec--browse-at)\n    (define-key map \"n\" #'forward-button)\n    (define-key map \"p\" #'backward-button)\n    map)\n  \"Keymap for `cider-browse-spec-mode'.\")\n\n(define-derived-mode cider-browse-spec-mode special-mode \"Specs\"\n  \"Major mode for browsing Clojure specs.\n\n\\\\{cider-browse-spec-mode-map}\"\n  (setq-local electric-indent-chars nil)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t)))\n\n(defvar cider-browse-spec--current-spec nil)\n\n(defvar cider-browse-spec-view-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map help-mode-map)\n    (define-key map (kbd \"RET\") #'cider-browse-spec--browse-at)\n    (define-key map \"^\" #'cider-browse-spec-all)\n    (define-key map \"e\" #'cider-browse-spec--print-curr-spec-example)\n    (define-key map \"n\" #'forward-button)\n    (define-key map \"p\" #'backward-button)\n    map)\n  \"Keymap for `cider-browse-spec-view-mode'.\")\n\n(define-derived-mode cider-browse-spec-view-mode help-mode \"Spec\"\n  \"Major mode for displaying CIDER spec.\n\n\\\\{cider-browse-spec-view-mode-map}\"\n  (setq-local cider-browse-spec--current-spec nil)\n  (setq-local electric-indent-chars nil)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t)))\n\n(defvar cider-browse-spec-example-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map cider-popup-buffer-mode-map)\n    (define-key map \"^\" #'cider-browse-spec-all)\n    (define-key map \"e\" #'cider-browse-spec--print-curr-spec-example)\n    (define-key map \"g\" #'revert-buffer)\n    map)\n  \"Keymap for `cider-browse-spec-example-mode'.\")\n\n(define-derived-mode cider-browse-spec-example-mode special-mode \"Example\"\n  \"Major mode for Clojure spec examples.\n\n\\\\{cider-browse-spec-example-mode-map}\"\n  (setq-local electric-indent-chars nil)\n  (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t)))\n\n;; Non interactive functions\n\n(define-button-type 'cider-browse-spec--spec\n  'action #'cider-browse-spec--browse-at\n  'face nil\n  'follow-link t\n  'help-echo \"View spec\")\n\n(defun cider-browse-spec--draw-list-buffer (buffer title specs)\n  \"Reset contents of BUFFER.\nDisplay TITLE at the top and SPECS are indented underneath.\"\n  (with-current-buffer buffer\n    (cider-browse-spec-mode)\n    (let ((inhibit-read-only t))\n      (erase-buffer)\n      (goto-char (point-max))\n      (insert (cider-propertize title 'emph) \"\\n\")\n      (dolist (spec-name specs)\n        (insert (propertize \"  \" 'spec-name spec-name))\n        (thread-first\n          (cider-font-lock-as-clojure spec-name)\n          (insert-text-button 'type 'cider-browse-spec--spec)\n          (button-put 'spec-name spec-name))\n        (insert (propertize \"\\n\" 'spec-name spec-name)))\n      (goto-char (point-min)))))\n\n(defun cider--qualified-keyword-p (str)\n  \"Return non nil if STR is a namespaced keyword.\"\n  (string-match-p \"^:.+/.+$\" str))\n\n(defun cider--spec-fn-p (value fn-name)\n  \"Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME.\"\n  (string-match-p (concat \"^\\\\(clojure.spec\\\\|clojure.spec.alpha\\\\|clojure.alpha.spec\\\\)/\" fn-name \"$\") value))\n\n(defun cider-browse-spec--render-schema-map (spec-form)\n  \"Render the s/schema map declaration SPEC-FORM.\"\n  (let ((name-spec-pairs (seq-partition (cdaadr spec-form) 2)))\n    (format \"(s/schema\\n {%s})\"\n            (string-join\n             (thread-last\n               (seq-sort-by #'car #'string< name-spec-pairs)\n               (mapcar (lambda (s) (concat (cl-first s) \" \" (cider-browse-spec--pprint (cl-second s))))))\n             \"\\n  \"))))\n\n(defun cider-browse-spec--render-schema-vector (spec-form)\n  \"Render the s/schema vector declaration SPEC-FORM.\"\n  (format \"(s/schema\\n [%s])\"\n          (string-join\n           (thread-last\n             (cl-second spec-form)\n             (mapcar (lambda (s) (cider-browse-spec--pprint s))))\n           \"\\n  \")))\n\n(defun cider-browse-spec--render-schema (spec-form)\n  \"Render the s/schema SPEC-FORM.\"\n  (let ((schema-args (cl-second spec-form)))\n    (if (and (listp schema-args)\n             (nrepl-dict-p (cl-first schema-args)))\n        (cider-browse-spec--render-schema-map spec-form)\n      (cider-browse-spec--render-schema-vector spec-form))))\n\n(defun cider-browse-spec--render-select (spec-form)\n  \"Render the s/select SPEC-FORM.\"\n  (let ((keyset (cl-second spec-form))\n        (selection (cl-third spec-form)))\n    (format \"(s/select\\n %s\\n [%s])\"\n            (cider-browse-spec--pprint keyset)\n            (string-join\n             (thread-last\n               selection\n               (mapcar (lambda (s) (cider-browse-spec--pprint s))))\n             \"\\n  \"))))\n\n(defun cider-browse-spec--render-union (spec-form)\n  \"Render the s/union SPEC-FORM.\"\n  (let ((keyset (cl-second spec-form))\n        (selection (cl-third spec-form)))\n    (format \"(s/union\\n %s\\n [%s])\"\n            (cider-browse-spec--pprint keyset)\n            (string-join\n             (thread-last\n               selection\n               (mapcar (lambda (s) (cider-browse-spec--pprint s))))\n             \"\\n  \"))))\n\n(defun cider-browse-spec--render-vector (spec-form)\n  \"Render SPEC-FORM as a vector.\"\n  (format \"[%s]\" (string-join (mapcar #'cider-browse-spec--pprint spec-form))))\n\n(defun cider-browse-spec--render-map-entry (spec-form)\n  \"Render SPEC-FORM as a map entry.\"\n  (let ((key (cl-first spec-form))\n        (value (cl-second spec-form)))\n    (format \"%s %s\" (cider-browse-spec--pprint key)\n            (if (listp value)\n                (cider-browse-spec--render-vector value)\n              (cider-browse-spec--pprint value)))))\n\n(defun cider-browse-spec--render-map (spec-form)\n  \"Render SPEC-FORM as a map.\"\n  (let ((map-entries (cl-rest spec-form)))\n    (format \"{%s}\" (thread-last\n                     (seq-partition map-entries 2)\n                     (seq-map #'cider-browse-spec--render-map-entry)\n                     (string-join)))))\n\n(defun cider-browse-spec--pprint (form)\n  \"Given a spec FORM builds a multi line string with a pretty render of that FORM.\"\n  (cond ((stringp form)\n         (if (cider--qualified-keyword-p form)\n             (with-temp-buffer\n               (thread-first\n                 form\n                 (insert-text-button 'type 'cider-browse-spec--spec)\n                 (button-put 'spec-name form))\n               (buffer-string))\n           ;; to make it easier to read replace all clojure.spec ns with s/\n           ;; and remove all clojure.core ns\n           (thread-last\n             form\n             (replace-regexp-in-string \"^\\\\(clojure.spec\\\\|clojure.spec.alpha\\\\|clojure.alpha.spec\\\\)/\" \"s/\")\n             (replace-regexp-in-string \"^\\\\(clojure.core\\\\)/\" \"\"))))\n\n        ((and (listp form) (stringp (cl-first form)))\n         (let ((form-tag (cl-first form)))\n           (cond\n            ;; prettier fns #()\n            ((string-equal form-tag \"clojure.core/fn\")\n             (if (equal (cl-second form) '(\"%\"))\n                 (format \"#%s\" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form)))))\n               (format \"(fn [%%] %s)\" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form)))))))\n            ;; prettier (s/and )\n            ((cider--spec-fn-p form-tag \"and\")\n             (format \"(s/and\\n%s)\" (string-join (thread-last\n                                                  (cl-rest form)\n                                                  (mapcar #'cider-browse-spec--pprint)\n                                                  (mapcar (lambda (x) (format \"%s\" x))))\n                                                \"\\n\")))\n            ;; prettier (s/or )\n            ((cider--spec-fn-p form-tag \"or\")\n             (let ((name-spec-pair (seq-partition (cl-rest form) 2)))\n               (format \"(s/or\\n%s)\" (string-join\n                                     (thread-last\n                                       name-spec-pair\n                                       (mapcar (lambda (s) (format \"%s %s\" (cl-first s) (cider-browse-spec--pprint (cl-second s))))))\n                                     \"\\n\"))))\n            ;; prettier (s/merge )\n            ((cider--spec-fn-p form-tag \"merge\")\n             (format \"(s/merge\\n%s)\" (string-join (thread-last\n                                                    (cl-rest form)\n                                                    (mapcar #'cider-browse-spec--pprint)\n                                                    (mapcar (lambda (x) (format \"%s\" x))))\n                                                  \"\\n\")))\n            ;; prettier (s/keys )\n            ((cider--spec-fn-p form-tag \"keys\")\n             (let ((keys-args (seq-partition (cl-rest form) 2)))\n               (format \"(s/keys%s)\" (thread-last\n                                      keys-args\n                                      (mapcar (lambda (s)\n                                                (let ((key-type (cl-first s))\n                                                      (specs-vec (cl-second s)))\n                                                  (concat \"\\n\" key-type\n                                                          \" [\"\n                                                          (string-join (thread-last\n                                                                         specs-vec\n                                                                         (mapcar #'cider-browse-spec--pprint)\n                                                                         (mapcar (lambda (x) (format \"%s\" x))))\n                                                                       \"\\n\")\n                                                          \"]\"))))\n                                      (cl-reduce #'concat)))))\n            ;; prettier (s/multi-spec)\n            ((cider--spec-fn-p form-tag \"multi-spec\")\n             (let ((multi-method (cl-second form))\n                   (retag (cl-third form))\n                   (sub-specs (cl-rest (cl-rest (cl-rest form)))))\n               (format \"(s/multi-spec %s %s\\n%s)\"\n                       multi-method\n                       retag\n                       (string-join\n                        (thread-last\n                          sub-specs\n                          (mapcar (lambda (s)\n                                    (concat \"\\n\\n\" (cl-first s) \" \" (cider-browse-spec--pprint (cl-second s))))))\n                        \"\\n\"))))\n            ;; prettier (s/cat )\n            ((cider--spec-fn-p form-tag \"cat\")\n             (let ((name-spec-pairs (seq-partition (cl-rest form) 2)))\n               (format \"(s/cat %s)\"\n                       (thread-last\n                         name-spec-pairs\n                         (mapcar (lambda (s)\n                                   (concat \"\\n\" (cl-first s) \" \" (cider-browse-spec--pprint (cl-second s)))))\n                         (cl-reduce #'concat)))))\n            ;; prettier (s/alt )\n            ((cider--spec-fn-p form-tag \"alt\")\n             (let ((name-spec-pairs (seq-partition (cl-rest form) 2)))\n               (format \"(s/alt %s)\"\n                       (thread-last\n                         name-spec-pairs\n                         (mapcar (lambda (s)\n                                   (concat \"\\n\" (cl-first s) \" \" (cider-browse-spec--pprint (cl-second s)))))\n                         (cl-reduce #'concat)))))\n            ;; prettier (s/fspec )\n            ((cider--spec-fn-p form-tag \"fspec\")\n             (thread-last\n               (seq-partition (cl-rest form) 2)\n               (cl-remove-if (lambda (s) (and (stringp (cl-second s))\n                                              (string-empty-p (cl-second s)))))\n               (mapcar (lambda (s)\n                         (format \"\\n%-11s: %s\" (pcase (cl-first s)\n                                                 (\":args\" \"arguments\")\n                                                 (\":ret\" \"returns\")\n                                                 (\":fn\" \"invariants\"))\n                                 (cider-browse-spec--pprint (cl-second s)))))\n               (cl-reduce #'concat)\n               (format \"%s\")))\n            ;; prettier (s/schema )\n            ((cider--spec-fn-p form-tag \"schema\")\n             (cider-browse-spec--render-schema form))\n            ;; prettier (s/select )\n            ((cider--spec-fn-p form-tag \"select\")\n             (cider-browse-spec--render-select form))\n            ;; prettier (s/union )\n            ((cider--spec-fn-p form-tag \"union\")\n             (cider-browse-spec--render-union form))\n            ;; every other with no special management\n            (t (format \"(%s %s)\"\n                       (cider-browse-spec--pprint form-tag)\n                       (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) \" \"))))))\n        ((nrepl-dict-p form)\n         (cider-browse-spec--render-map form))\n        (t (format \"%s\" form))))\n\n(defun cider-browse-spec--pprint-indented (spec-form)\n  \"Indent (pretty-print) and font-lock SPEC-FORM.\nReturn the result as a string.\"\n  (with-temp-buffer\n    (clojure-mode)\n    (insert (cider-browse-spec--pprint spec-form))\n    (indent-region (point-min) (point-max))\n    (font-lock-ensure)\n    (buffer-string)))\n\n(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form)\n  \"Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM.\nDisplay SPEC as a title and uses `cider-browse-spec--pprint' to display\na more user friendly representation of SPEC-FORM.\"\n  (with-current-buffer buffer\n    (let ((inhibit-read-only t))\n      (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer)\n      (goto-char (point-max))\n      (insert (cider-font-lock-as-clojure spec) \"\\n\\n\")\n      (insert (cider-browse-spec--pprint-indented spec-form))\n      (cider--make-back-forward-xrefs)\n      (current-buffer))))\n\n(defun cider-browse-spec--browse (spec)\n  \"Browse SPEC.\"\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"spec-form\")\n  ;; Expand auto-resolved keywords\n  (when-let* ((val (and (string-match-p \"^::.+\" spec)\n                        (nrepl-dict-get (cider-sync-tooling-eval spec (cider-current-ns)) \"value\"))))\n    (setq spec val))\n  (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary)\n    (setq-local cider-browse-spec--current-spec spec)\n    (cider-browse-spec--draw-spec-buffer (current-buffer)\n                                         spec\n                                         (cider-sync-request:spec-form spec))\n    (goto-char (point-min))\n    (current-buffer)))\n\n(defun cider-browse-spec--browse-at (&optional pos)\n  \"View the definition of a spec.\n\nOptional argument POS is the position of a spec, defaulting to point.  POS\nmay also be a button, so this function can be used a the button's `action'\nproperty.\"\n  (interactive)\n  (let ((pos (or pos (point))))\n    (when-let* ((spec (button-get pos 'spec-name)))\n      (cider-browse-spec--browse spec))))\n\n;; Interactive Functions\n\n(defun cider-browse-spec--print-curr-spec-example ()\n  \"Generate and print an example of the current spec.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"spec-example\")\n  (if-let* ((spec cider-browse-spec--current-spec))\n      (if-let* ((example (cider-sync-request:spec-example spec)))\n          (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary)\n            (setq-local cider-browse-spec--current-spec spec)\n            (let ((inhibit-read-only t))\n              (insert \"Example of \" (cider-font-lock-as-clojure spec))\n              (insert \"\\n\\n\")\n              (insert (cider-font-lock-as-clojure example))\n              (goto-char (point-min))))\n        (error (format \"No example for spec %s\" spec)))\n    (error \"No current spec\")))\n\n(defun cider-browse-spec--example-revert-buffer-function (&rest _)\n  \"`revert-buffer' function for `cider-browse-spec-example-mode'.\n\nGenerates a new example for the current spec.\"\n  (cider-browse-spec--print-curr-spec-example))\n\n;;;###autoload\n(defun cider-browse-spec (spec)\n  \"Browse SPEC definition.\"\n  (interactive (list (completing-read \"Browse spec: \"\n                                      (cider-sync-request:spec-list)\n                                      nil nil\n                                      (cider-symbol-at-point))))\n  (cider-browse-spec--browse spec))\n\n(defun cider-browse-spec-regex (regex)\n  \"Open the list of specs that matches REGEX in a popup buffer.\nDisplays all specs when REGEX is nil.\"\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"spec-list\")\n  (let ((filter-regex (or regex \"\")))\n    (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary)\n      (let ((specs (cider-sync-request:spec-list filter-regex)))\n        (cider-browse-spec--draw-list-buffer (current-buffer)\n                                             (if (string-empty-p filter-regex)\n                                                 \"All specs in registry\"\n                                               (format \"All specs matching regex `%s' in registry\" filter-regex))\n                                             specs)))))\n\n;;;###autoload\n(defun cider-browse-spec-all (&optional arg)\n  \"Open list of specs in a popup buffer.\n\nWith a prefix argument ARG, prompts for a regexp to filter specs.\nNo filter applied if the regexp is the empty string.\"\n  (interactive \"P\")\n  (cider-browse-spec-regex (if arg (read-string \"Filter regex: \") \"\")))\n\n(provide 'cider-browse-spec)\n\n;;; cider-browse-spec.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-cheatsheet.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53542328,"end":53542371},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53542371},"to":{"change":3,"start":53520735,"end":53520735},"introduced_by":3}],"inode":{"change":3,"pos":53520735}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53520735},"to":{"change":3,"start":53520736,"end":53542327},"introduced_by":3}],"inode":{"change":3,"pos":53520735}},"content":[{"Del":";;; cider-cheatsheet.el --- Quick reference for Clojure        -*- lexical-binding: t -*-\n\n;; Copyright © 2019-2022 Kris Jenkins, Bozhidar Batsov and CIDER contributors\n;;\n;; Author: Kris Jenkins \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; A quick reference system for Clojure.  Fast, searchable & available offline.\n\n;; Mostly taken from Kris Jenkins' `clojure-cheatsheet'\n;; See: https://github.com/clojure-emacs/clojure-cheatsheet\n\n;;; Code:\n\n(require 'cider-doc)\n(require 'seq)\n\n(defconst cider-cheatsheet-hierarchy\n  '((\"Primitives\"\n     (\"Numbers\"\n      (\"Arithmetic\"\n       (clojure.core + - * / quot rem mod dec inc max min))\n      (\"Compare\"\n       (clojure.core = == not= < > <= >= compare))\n      (\"Bitwise\"\n       (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right))\n      (\"Cast\"\n       (clojure.core byte short long int float double bigdec bigint biginteger num rationalize))\n      (\"Test\"\n       (clojure.core nil? some? identical? zero? pos? neg? even? odd?))\n      (\"Random\"\n       (clojure.core rand rand-int))\n      (\"BigDecimal\"\n       (clojure.core with-precision))\n      (\"Ratios\"\n       (clojure.core numerator denominator ratio?))\n      (\"Arbitrary Precision Arithmetic\"\n       (clojure.core +\\' -\\' *\\' inc\\' dec\\'))\n      (\"Unchecked\"\n       (clojure.core *unchecked-math*\n                     unchecked-add\n                     unchecked-add-int\n                     unchecked-byte\n                     unchecked-char\n                     unchecked-dec\n                     unchecked-dec-int\n                     unchecked-divide-int\n                     unchecked-double\n                     unchecked-float\n                     unchecked-inc\n                     unchecked-inc-int\n                     unchecked-int\n                     unchecked-long\n                     unchecked-multiply\n                     unchecked-multiply-int\n                     unchecked-negate\n                     unchecked-negate-int\n                     unchecked-remainder-int\n                     unchecked-short\n                     unchecked-subtract\n                     unchecked-subtract-int)))\n\n     (\"Strings\"\n      (\"Create\"\n       (clojure.core str format))\n      (\"Use\"\n       (clojure.core count get subs compare)\n       (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?))\n      (\"Regex\"\n       (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups)\n       (clojure.string replace replace-first re-quote-replacement))\n      (\"Letters\"\n       (clojure.string capitalize lower-case upper-case))\n      (\"Trim\"\n       (clojure.string trim trim-newline triml trimr))\n      (\"Test\"\n       (clojure.core char char? string?)\n       (clojure.string blank?)))\n\n     (\"Other\"\n      (\"Characters\"\n       (clojure.core char char-name-string char-escape-string))\n      (\"Keywords\"\n       (clojure.core keyword keyword? find-keyword))\n      (\"Symbols\"\n       (clojure.core symbol symbol? gensym))\n      (\"Data Readers\"\n       (clojure.core *data-readers* default-data-readers *default-data-reader-fn*))))\n\n    (\"Collections\"\n     (\"Generic Ops\"\n      (clojure.core count bounded-count empty not-empty into conj))\n     (\"Tree Walking\"\n      (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys))\n     (\"Content tests\"\n      (clojure.core distinct? empty? every? not-every? some not-any?))\n     (\"Capabilities\"\n      (clojure.core sequential? associative? sorted? counted? reversible?))\n     (\"Type tests\"\n      (clojure.core type class coll? list? vector? set? map? seq?\n                    number? integer? float? decimal? class? rational? ratio?\n                    chunked-seq? reduced? special-symbol? record?))\n     (\"Lists\"\n      (\"Create\"\n       (clojure.core list list*))\n      (\"Examine\"\n       (clojure.core first nth peek))\n      (\"Change\"\n       (clojure.core cons conj rest pop)))\n\n     (\"Vectors\"\n      (\"Create\"\n       (clojure.core vec vector vector-of))\n      (\"Examine\"\n       (clojure.core get peek))\n\n      (\"Change\"\n       (clojure.core assoc pop subvec replace conj rseq))\n      (\"Ops\"\n       (clojure.core mapv filterv reduce-kv)))\n\n     (\"Sets\"\n      (\"Create\"\n       (clojure.core set hash-set sorted-set sorted-set-by))\n      (\"Examine\"\n       (clojure.core get contains?))\n      (\"Change\"\n       (clojure.core conj disj))\n      (\"Relational Algebra\"\n       (clojure.set join select project union difference intersection))\n      (\"Get map\"\n       (clojure.set index rename-keys rename map-invert))\n      (\"Test\"\n       (clojure.set subset? superset?))\n      (\"Sorted Sets\"\n       (clojure.core rseq subseq rsubseq)))\n\n     (\"Maps\"\n      (\"Create\"\n       (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by))\n      (\"Examine\"\n       (clojure.core get get-in contains? find keys vals map-entry?))\n      (\"Change\"\n       (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in))\n      (\"Entry\"\n       (clojure.core key val))\n      (\"Sorted Maps\"\n       (clojure.core rseq subseq rsubseq)))\n\n     (\"Hashes\"\n      (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash))\n\n     (\"Volatiles\"\n      (clojure.core volatile! volatile? vreset! vswap!)))\n\n    (\"Functions\"\n     (\"Create\"\n      (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline))\n     (\"Call\"\n      (clojure.core -> ->> some-> some->> as-> cond-> cond->>))\n     (\"Test\"\n      (clojure.core fn? ifn?)))\n\n    (\"Transducers\"\n     (\"Create\"\n      (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while))\n     (\"Call\"\n      (clojure.core ->Eduction eduction into sequence transduce completing run!))\n     (\"Early Termination\"\n      (clojure.core deref reduced reduced? ensure-reduced unreduced)))\n\n    (\"Spec\"\n     (\"Operations\"\n      (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?))\n     (\"Generator Ops\"\n      (clojure.spec.alpha gen exercise exercise-fn))\n     (\"Defn & Registry\"\n      (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen))\n     (\"Logical\"\n      (clojure.spec.alpha and or))\n     (\"Collection\"\n      (clojure.spec.alpha coll-of map-of every every-kv keys merge))\n     (\"Regex \"\n      (clojure.spec.alpha cat alt * + \\? & keys*))\n     (\"Range\"\n      (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?))\n     (\"Custom Explain\"\n      (clojure.spec.alpha explain-printer *explain-out*))\n     (\"Other\"\n      (clojure.spec.alpha nilable multi-spec fspec conformer))\n\n     (\"Predicates with test.check generators\"\n      (\"Numbers\"\n       (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?))\n      (\"Symbols & Keywords\"\n       (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?))\n      (\"Scalars\"\n       (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?))\n      (\"Collections\"\n       (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?))\n      (\"Other\"\n       (clojure.core any?))))\n\n    (\"Other\"\n     (\"XML\"\n      (clojure.core xml-seq)\n      (clojure.xml parse))\n     (\"REPL\"\n      (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*))\n     (\"EDN\"\n      (clojure.edn read read-string))\n     (\"Compiling Code & Class Generation\"\n      (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test))\n     (\"Misc\"\n      (clojure.core eval force name *clojure-version* clojure-version *command-line-args*))\n     (\"Pretty Printing\"\n      (clojure.pprint pprint print-table pp *print-right-margin*))\n     (\"Browser / Shell\"\n      (clojure.java.browse browse-url)\n      (clojure.java.shell sh with-sh-dir with-sh-env)))\n\n    (\"Vars & Global Environment\"\n     (\"Def Variants\"\n      (:special def)\n      (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord))\n     (\"Interned Vars\"\n      (:special var)\n      (clojure.core declare intern binding find-var))\n     (\"Var Objects\"\n      (clojure.core with-local-vars var-get var-set alter-var-root var?))\n     (\"Var Validators\"\n      (clojure.core set-validator! get-validator)))\n\n    (\"Reader Conditionals\"\n     (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?))\n\n    (\"Abstractions\"\n     (\"Protocols\"\n      (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders))\n     (\"Records & Types\"\n      (clojure.core defrecord deftype))\n     (\"Multimethods\"\n      (\"Define\"\n       (clojure.core defmulti defmethod))\n      (\"Dispatch\"\n       (clojure.core get-method methods))\n      (\"Remove\"\n       (clojure.core remove-method remove-all-methods))\n      (\"Prefer\"\n       (clojure.core prefer-method prefers))\n      (\"Relation\"\n       (clojure.core derive isa? parents ancestors descendants make-hierarchy))))\n\n    (\"Macros\"\n     (\"Create\"\n      (clojure.core defmacro definline))\n     (\"Debug\"\n      (clojure.core macroexpand-1 macroexpand)\n      (clojure.walk macroexpand-all))\n     (\"Branch\"\n      (clojure.core and or when when-not when-let when-first if-not if-let cond condp case))\n     (\"Loop\"\n      (clojure.core for doseq dotimes while))\n     (\"Arrange\"\n      (clojure.core .. doto ->))\n     (\"Scope\"\n      (clojure.core binding locking time)\n      (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn))\n     (\"Lazy\"\n      (clojure.core lazy-cat lazy-seq delay delay?))\n     (\"Doc\"\n      (clojure.core assert comment)\n      (clojure.repl doc dir dir-fn source-fn)))\n\n    (\"Java Interop\"\n     (\"General\"\n      (:special new set!)\n      (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases))\n     (\"Cast\"\n      (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger))\n     (\"Exceptions\"\n      (:special throw try catch finally)\n      (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec)\n      (clojure.repl pst))\n     (\"Arrays\"\n      (\"Create\"\n       (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array))\n      (\"Manipulate\"\n       (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float))\n      (\"Cast\"\n       (clojure.core booleans bytes chars doubles floats ints longs shorts)))\n     (\"Proxy\"\n      (\"Create\"\n       (clojure.core proxy get-proxy-class construct-proxy init-proxy))\n      (\"Misc\"\n       (clojure.core proxy-mappings proxy-super update-proxy))))\n\n    (\"Namespaces\"\n     (\"Current\"\n      (clojure.core *ns*))\n     (\"Create Switch\"\n      (clojure.core ns in-ns create-ns))\n     (\"Add\"\n      (clojure.core alias import intern refer refer-clojure))\n     (\"Find\"\n      (clojure.core all-ns find-ns))\n     (\"Examine\"\n      (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers))\n     (\"From symbol\"\n      (clojure.core resolve namespace ns-resolve the-ns))\n     (\"Remove\"\n      (clojure.core ns-unalias ns-unmap remove-ns)))\n    (\"Loading\"\n     (\"Load libs\"\n      (clojure.core require use import refer))\n     (\"List Loaded\"\n      (clojure.core loaded-libs))\n     (\"Load Misc\"\n      (clojure.core load load-file load-reader load-string)))\n\n    (\"Concurrency\"\n     (\"Atoms\"\n      (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!))\n     (\"Futures\"\n      (clojure.core future future-call future-cancel future-cancelled? future-done? future?))\n     (\"Threads\"\n      (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings))\n\n     (\"Misc\"\n      (clojure.core locking pcalls pvalues pmap seque promise deliver))\n\n     (\"Refs & Transactions\"\n      (\"Create\"\n       (clojure.core ref))\n      (\"Examine\"\n       (clojure.core deref))\n      (\"Transaction\"\n       (clojure.core sync dosync io!))\n      (\"In Transaction\"\n       (clojure.core ensure ref-set alter commute))\n      (\"Validators\"\n       (clojure.core get-validator set-validator!))\n      (\"History\"\n       (clojure.core ref-history-count ref-max-history ref-min-history)))\n\n     (\"Agents & Asynchronous Actions\"\n      (\"Create\"\n       (clojure.core agent))\n      (\"Examine\"\n       (clojure.core agent-error))\n      (\"Change State\"\n       (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!))\n      (\"Block Waiting\"\n       (clojure.core await await-for))\n      (\"Ref Validators\"\n       (clojure.core get-validator set-validator!))\n      (\"Watchers\"\n       (clojure.core add-watch remove-watch))\n      (\"Thread Handling\"\n       (clojure.core shutdown-agents))\n      (\"Error\"\n       (clojure.core error-handler set-error-handler! error-mode set-error-mode!))\n      (\"Misc\"\n       (clojure.core *agent* release-pending-sends))))\n\n    (\"Sequences\"\n     (\"Creating a Lazy Seq\"\n      (\"From Collection\"\n       (clojure.core seq sequence keys vals rseq subseq rsubseq))\n      (\"From Producer Fn\"\n       (clojure.core lazy-seq repeatedly iterate))\n      (\"From Constant\"\n       (clojure.core repeat range))\n      (\"From Other\"\n       (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq))\n      (\"From Seq\"\n       (clojure.core keep keep-indexed)))\n\n     (\"Seq in, Seq out\"\n      (\"Get shorter\"\n       (clojure.core distinct dedupe filter remove for))\n      (\"Get longer\"\n       (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose)))\n     (\"Tail-items\"\n      (clojure.core rest nthrest fnext nnext drop drop-while take-last for))\n     (\"Head-items\"\n      (clojure.core take take-nth take-while butlast drop-last for))\n     (\"Change\"\n      (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample))\n     (\"Rearrange\"\n      (clojure.core reverse sort sort-by compare))\n     (\"Process items\"\n      (clojure.core map pmap map-indexed mapcat for replace seque))\n\n     (\"Using a Seq\"\n      (\"Extract item\"\n       (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key))\n      (\"Construct coll\"\n       (clojure.core zipmap into reduce reductions set vec into-array to-array-2d))\n      (\"Pass to fn\"\n       (clojure.core apply))\n      (\"Search\"\n       (clojure.core some filter))\n      (\"Force evaluation\"\n       (clojure.core doseq dorun doall))\n      (\"Check for forced\"\n       (clojure.core realized?))))\n\n    (\"Zippers\"\n     (\"Create\"\n      (clojure.zip zipper seq-zip vector-zip xml-zip))\n     (\"Get loc\"\n      (clojure.zip up down left right leftmost rightmost))\n     (\"Get seq\"\n      (clojure.zip lefts rights path children))\n     (\"Change\"\n      (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove))\n     (\"Move\"\n      (clojure.zip next prev))\n     (\"XML\"\n      (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->))\n     (\"Misc\"\n      (clojure.zip root node branch? end?)))\n\n    (\"Documentation\"\n     (\"REPL\"\n      (clojure.repl doc find-doc apropos source pst)\n      (clojure.java.javadoc javadoc)))\n\n    (\"Transients\"\n     (\"Create\"\n      (clojure.core transient persistent!))\n     (\"Change\"\n      (clojure.core conj! pop! assoc! dissoc! disj!)))\n    (\"Misc\"\n     (\"Compare\"\n      (clojure.core = == identical? not= not compare)\n      (clojure.data diff))\n     (\"Test\"\n      (clojure.core true? false? nil? instance?)))\n\n    (\"IO\"\n     (\"To/from ...\"\n      (clojure.core spit slurp))\n     (\"To *out*\"\n      (clojure.core pr prn print printf println newline)\n      (clojure.pprint print-table))\n     (\"To writer\"\n      (clojure.pprint pprint cl-format))\n     (\"To string\"\n      (clojure.core format with-out-str pr-str prn-str print-str println-str))\n     (\"From *in*\"\n      (clojure.core read-line read))\n     (\"From reader\"\n      (clojure.core line-seq read))\n     (\"From string\"\n      (clojure.core read-string with-in-str))\n     (\"Open\"\n      (clojure.core with-open)\n      (clojure.java.io reader writer input-stream output-stream))\n     (\"Interop\"\n      (clojure.java.io make-writer make-reader make-output-stream make-input-stream))\n     (\"Misc\"\n      (clojure.core flush file-seq *in* *out* *err*)\n      (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents)))\n\n    (\"Metadata\"\n     (clojure.core meta with-meta alter-meta! reset-meta! vary-meta))\n\n    (\"Special Forms\"\n     (:special def if do quote var recur throw try monitor-enter monitor-exit)\n     (clojure.core fn loop)\n     (\"Binding / Destructuring\"\n      (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some)))\n\n    (\"Async\"\n     (\"Main\"\n      (clojure.core.async go go-loop ! >!! chan put! take take! close! timeout offer! poll! promise-chan))\n     (\"Choice\"\n      (clojure.core.async alt! alt!! alts! alts!! do-alts))\n     (\"Buffering\"\n      (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?))\n     (\"Pipelines\"\n      (clojure.core.async pipeline pipeline-async pipeline-blocking))\n     (\"Threading\"\n      (clojure.core.async thread thread-call))\n     (\"Mixing\"\n      (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique))\n     (\"Multiples\"\n      (clojure.core.async mult tap untap untap-all))\n     (\"Publish/Subscribe\"\n      (clojure.core.async pub sub unsub unsub-all))\n     (\"Higher Order\"\n      (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split))\n     (\"Pre-Populate\"\n      (clojure.core.async into onto-chan to-chan)))\n    (\"Unit Tests\"\n     (\"Defining\"\n      (clojure.test deftest deftest- testing is are))\n     (\"Running\"\n      (clojure.test run-tests run-all-tests test-vars))\n     (\"Fixtures\"\n      (clojure.test use-fixtures join-fixtures compose-fixtures))))\n  \"A data structure for Clojure cheatsheet information.\n\nIt's a tree, where the head of each list determines the context of the rest\nof the list.  The head may be:\n\n  - A string, in which case it's a (sub)heading for the rest of the items.\n\n  - A symbol, in which case it's the Clojure namespace of the symbols that\n    follow it.\n\n  - The keyword :special, in which case it's a Clojure special form\n\n  - Any other keyword, in which case it's a typed item that will be passed\n    through.\n\nNote that some Clojure symbols appear in more than once.  This is entirely\nintentional.  For instance, `map` belongs in the sections on collections\nand transducers.\")\n\n(defun cider-cheatsheet--expand-vars (list)\n  \"Expand the symbols in LIST to fully-qualified var names.\n\nThis list is supposed to have the following format:\n\n  (my-ns var1 var2 var3)\"\n  (let ((ns (car list))\n        (vars (cdr list)))\n    (if (eq ns :special)\n        (mapcar #'symbol-name vars)\n      (mapcar (lambda (var) (format \"%s/%s\" ns var)) vars))))\n\n(defun cider-cheatsheet--select-var (var-list)\n  \"Expand the symbols in VAR-LIST to fully-qualified var names.\n\nThe list can hold one or more lists inside - one per each namespace.\"\n  (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars\n                                     (seq-remove (lambda (list)\n                                                   (eq (car list) :url))\n                                                 var-list))))\n    (cider-doc-lookup (completing-read \"Select var: \" namespaced-vars))))\n\n;;;###autoload\n(defun cider-cheatsheet ()\n  \"Navigate `cider-cheatsheet-hierarchy' with `completing-read'.\n\nWhen you make it to a Clojure var its doc buffer gets displayed.\"\n  (interactive)\n  (let ((cheatsheet-data cider-cheatsheet-hierarchy))\n    (while (stringp (caar cheatsheet-data))\n      (let* ((sections (mapcar #'car cheatsheet-data))\n             (sel-section (completing-read \"Select cheatsheet section: \" sections))\n             (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data)))\n        (setq cheatsheet-data (cdr section-data))))\n    (cider-cheatsheet--select-var cheatsheet-data)))\n\n(provide 'cider-cheatsheet)\n\n;;; cider-cheatsheet.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-classpath.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53520691,"end":53520733},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53520733},"to":{"change":3,"start":53517054,"end":53517054},"introduced_by":3}],"inode":{"change":3,"pos":53517054}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53517054},"to":{"change":3,"start":53517055,"end":53520690},"introduced_by":3}],"inode":{"change":3,"pos":53517054}},"content":[{"Del":";;; cider-classpath.el --- Basic Java classpath browser  -*- lexical-binding: t; -*-\n\n;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors\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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Basic Java classpath browser for CIDER.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'subr-x)\n\n(defvar cider-classpath-buffer \"*cider-classpath*\")\n\n(defvar cider-classpath-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map cider-popup-buffer-mode-map)\n    (define-key map (kbd \"RET\") #'cider-classpath-operate-on-point)\n    (define-key map \"n\" #'next-line)\n    (define-key map \"p\" #'previous-line)\n    map))\n\n(defvar cider-classpath-mouse-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map [mouse-1] #'cider-classpath-handle-mouse)\n    map))\n\n(define-derived-mode cider-classpath-mode special-mode \"classpath\"\n  \"Major mode for browsing the entries in Java's classpath.\n\n\\\\{cider-classpath-mode-map}\"\n  (setq-local electric-indent-chars nil)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t)))\n\n(defun cider-classpath-list (buffer items)\n  \"Populate BUFFER with ITEMS.\"\n  (with-current-buffer buffer\n    (cider-classpath-mode)\n    (let ((inhibit-read-only t))\n      (erase-buffer)\n      (dolist (item items)\n        (insert item \"\\n\"))\n      (goto-char (point-min)))))\n\n(defun cider-classpath-properties (text)\n  \"Decorate TEXT with a clickable keymap and function face.\"\n  (let ((face (cond\n               ((not (file-exists-p text)) 'font-lock-warning-face)\n               ((file-directory-p text) 'dired-directory)\n               (t 'default))))\n    (propertize text\n                'font-lock-face face\n                'mouse-face 'highlight\n                'keymap cider-classpath-mouse-map)))\n\n(defun cider-classpath-operate-on-point ()\n  \"Expand browser according to thing at current point.\"\n  (interactive)\n  (let* ((bol (line-beginning-position))\n         (eol (line-end-position))\n         (line (buffer-substring-no-properties bol eol)))\n    (find-file-other-window line)))\n\n(defun cider-classpath-handle-mouse (_event)\n  \"Handle mouse click EVENT.\"\n  (interactive \"e\")\n  (cider-classpath-operate-on-point))\n\n;;;###autoload\n(defun cider-classpath ()\n  \"List all classpath entries.\"\n  (interactive)\n  (cider-ensure-connected)\n  (with-current-buffer (cider-popup-buffer cider-classpath-buffer 'select nil 'ancillary)\n    (cider-classpath-list (current-buffer)\n                          (mapcar (lambda (name)\n                                    (cider-classpath-properties name))\n                                  (cider-classpath-entries)))))\n\n;;;###autoload\n(defun cider-open-classpath-entry ()\n  \"Open a classpath entry.\"\n  (interactive)\n  (cider-ensure-connected)\n  (when-let* ((entry (completing-read \"Classpath entries: \" (cider-classpath-entries))))\n    (find-file-other-window entry)))\n\n(provide 'cider-classpath)\n\n;;; cider-classpath.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-client.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53517013,"end":53517052},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53517052},"to":{"change":3,"start":53480907,"end":53480907},"introduced_by":3}],"inode":{"change":3,"pos":53480907}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53480907},"to":{"change":3,"start":53480908,"end":53517012},"introduced_by":3}],"inode":{"change":3,"pos":53480907}},"content":[{"Del":";;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov\n;;\n;; Author: Bozhidar Batsov \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; A layer of abstraction above the low-level nREPL client code.\n\n;;; Code:\n\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n(require 'parseedn)\n\n(require 'clojure-mode)\n(require 'spinner)\n\n(require 'cider-connection)\n(require 'cider-common)\n(require 'cider-util)\n(require 'nrepl-client)\n\n\f\n;;; Eval spinner\n(defcustom cider-eval-spinner-type 'progress-bar\n  \"Appearance of the evaluation spinner.\n\nValue is a symbol.  The possible values are the symbols in the\n`spinner-types' variable.\"\n  :type 'symbol\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-show-eval-spinner t\n  \"When true, show the evaluation spinner in the mode line.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-eval-spinner-delay 1\n  \"Amount of time, in seconds, after which the evaluation spinner will be shown.\"\n  :type 'integer\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-enhanced-cljs-completion-p t\n  \"This setting enables dynamic cljs completions.\nThat is, expressions at point are evaluated and the properties of the\nresulting value are used to compute completions.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.23.0\"))\n\n(defcustom cider-before-eval-hook nil\n  \"List of functions to call before eval request is sent to nrepl.\"\n  :type 'hook\n  :group 'cider\n  :package-version '(cider . \"1.2.0\"))\n\n(defcustom cider-after-eval-done-hook nil\n  \"List of functions to call after eval was responded by nrepl with done status.\"\n  :type 'hook\n  :group 'cider\n  :package-version '(cider . \"1.2.0\"))\n\n(defun cider-spinner-start (buffer)\n  \"Start the evaluation spinner in BUFFER.\nDo nothing if `cider-show-eval-spinner' is nil.\"\n  (when cider-show-eval-spinner\n    (with-current-buffer buffer\n      (spinner-start cider-eval-spinner-type nil\n                     cider-eval-spinner-delay))))\n\n(defun cider-eval-spinner (eval-buffer response)\n  \"Handle RESPONSE stopping the spinner.\nEVAL-BUFFER is the buffer where the spinner was started.\"\n  ;; buffer still exists and\n  ;; we've got status \"done\" from nrepl\n  ;; stop the spinner\n  (when (and (buffer-live-p eval-buffer)\n             (let ((status (nrepl-dict-get response \"status\")))\n               (or (member \"done\" status)\n                   (member \"eval-error\" status)\n                   (member \"error\" status))))\n    (with-current-buffer eval-buffer\n      (when spinner-current (spinner-stop)))))\n\n\f\n;;; Evaluation helpers\n(defun cider-ns-form-p (form)\n  \"Check if FORM is an ns form.\"\n  (string-match-p \"^[[:space:]]*\\(ns\\\\([[:space:]]*$\\\\|[[:space:]]+\\\\)\" form))\n\n(defun cider-ns-from-form (ns-form)\n  \"Get ns substring from NS-FORM.\"\n  (when (string-match \"^[ \\t\\n]*\\(ns[ \\t\\n]+\\\\([^][ \\t\\n(){}]+\\\\)\" ns-form)\n    (match-string-no-properties 1 ns-form)))\n\n(defvar-local cider-buffer-ns nil\n  \"Current Clojure namespace of some buffer.\nUseful for special buffers (e.g. REPL, doc buffers) that have to keep track\nof a namespace.  This should never be set in Clojure buffers, as there the\nnamespace should be extracted from the buffer's ns form.\")\n\n(defun cider-current-ns (&optional no-default)\n  \"Return the current ns.\nThe ns is extracted from the ns form for Clojure buffers and from\n`cider-buffer-ns' for all other buffers.  If it's missing, use the current\nREPL's ns, otherwise fall back to \\\"user\\\".  When NO-DEFAULT is non-nil, it\nwill return nil instead of \\\"user\\\".\"\n  (or cider-buffer-ns\n      (clojure-find-ns)\n      (when-let* ((repl (cider-current-repl)))\n        (buffer-local-value 'cider-buffer-ns repl))\n      (if no-default nil \"user\")))\n\n(defun cider-path-to-ns (relpath)\n  \"Transform RELPATH to Clojure namespace.\nRemove extension and substitute \\\"/\\\" with \\\".\\\", \\\"_\\\" with \\\"-\\\".\"\n  (thread-last\n    relpath\n    (file-name-sans-extension)\n    (replace-regexp-in-string \"/\" \".\")\n    (replace-regexp-in-string \"_\" \"-\")))\n\n(defun cider-expected-ns (&optional path)\n  \"Return the namespace string matching PATH, or nil if not found.\nIf PATH is nil, use the path to the file backing the current buffer.  The\ncommand falls back to `clojure-expected-ns' in the absence of an active\nnREPL connection.\"\n  (if (cider-connected-p)\n      (let* ((path (file-truename (or path buffer-file-name)))\n             (relpath (thread-last\n                        (cider-classpath-entries)\n                        (seq-filter #'file-directory-p)\n                        (seq-map (lambda (dir)\n                                   (when (file-in-directory-p path dir)\n                                     (file-relative-name path dir))))\n                        (seq-filter #'identity)\n                        (seq-sort (lambda (a b)\n                                    (< (length a) (length b))))\n                        (car))))\n        (if relpath\n            (cider-path-to-ns relpath)\n          (clojure-expected-ns path)))\n    (clojure-expected-ns path)))\n\n(defun cider-nrepl-op-supported-p (op &optional connection skip-ensure)\n  \"Check whether the CONNECTION supports the nREPL middleware OP.\nSkip check if repl is active if SKIP-ENSURE is non nil.\"\n  (nrepl-op-supported-p op (or connection (cider-current-repl nil (if skip-ensure\n                                                                      nil\n                                                                    'ensure)))))\n\n(defun cider-ensure-op-supported (op)\n  \"Check for support of middleware op OP.\nSignal an error if it is not supported.\"\n  (unless (cider-nrepl-op-supported-p op)\n    (user-error \"`%s' requires the nREPL op \\\"%s\\\" (provided by cider-nrepl)\" this-command op)))\n\n(defun cider-nrepl-send-request (request callback &optional connection tooling)\n  \"Send REQUEST and register response handler CALLBACK.\nREQUEST is a pair list of the form (\\\"op\\\" \\\"operation\\\" \\\"par1-name\\\"\n                                    \\\"par1\\\" ... ).\nIf CONNECTION is provided dispatch to that connection instead of\nthe current connection.  Return the id of the sent message.\nIf TOOLING is truthy then the tooling session is used.\"\n  (nrepl-send-request request callback (or connection (cider-current-repl 'any 'ensure)) tooling))\n\n(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input)\n  \"Send REQUEST to the nREPL server synchronously using CONNECTION.\nHold till final \\\"done\\\" message has arrived and join all response messages\nof the same \\\"op\\\" that came along and return the accumulated response.\nIf ABORT-ON-INPUT is non-nil, the function will return nil\nat the first sign of user input, so as not to hang the\ninterface.\"\n  (nrepl-send-sync-request request\n                           (or connection (cider-current-repl 'any 'ensure))\n                           abort-on-input))\n\n(defun cider-nrepl-send-unhandled-request (request &optional connection)\n  \"Send REQUEST to the nREPL CONNECTION and ignore any responses.\nImmediately mark the REQUEST as done.  Return the id of the sent message.\"\n  (let* ((conn (or connection (cider-current-repl 'any 'ensure)))\n         (id (nrepl-send-request request #'ignore conn)))\n    (with-current-buffer conn\n      (nrepl--mark-id-completed id))\n    id))\n\n(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection)\n  \"Send the request INPUT and register the CALLBACK as the response handler.\nIf NS is non-nil, include it in the request.  LINE and COLUMN, if non-nil,\ndefine the position of INPUT in its buffer.  ADDITIONAL-PARAMS is a plist\nto be appended to the request message.  CONNECTION is the connection\nbuffer, defaults to (cider-current-repl).\"\n  (let ((connection (or connection (cider-current-repl nil 'ensure)))\n        (eval-buffer (current-buffer)))\n    (run-hooks 'cider-before-eval-hook)\n    (nrepl-request:eval input\n                        (lambda (response)\n                          (when cider-show-eval-spinner\n                            (cider-eval-spinner connection response))\n                          (when (and (buffer-live-p eval-buffer)\n                                     (member \"done\" (nrepl-dict-get response \"status\")))\n                            (with-current-buffer eval-buffer\n                              (run-hooks 'cider-after-eval-done-hook)))\n                          (funcall callback response))\n                        connection\n                        ns line column additional-params)\n    (cider-spinner-start connection)))\n\n(defun cider-nrepl-sync-request:eval (input &optional connection ns)\n  \"Send the INPUT to the nREPL CONNECTION synchronously.\nIf NS is non-nil, include it in the eval request.\"\n  (nrepl-sync-request:eval input (or connection (cider-current-repl nil 'ensure)) ns))\n\n(defcustom cider-format-code-options nil\n  \"A map of options that will be passed to `cljfmt' to format code.\nAssuming this is the Clojure map you want to use as `cljfmt' options:\n\n  {:indents {org.me/foo [[:inner 0]]}\n   :alias-map {\\\"me\\\" \\\"org.me\\\"}}\n\nyou need to encode it as the following plist:\n\n  '((\\\"indents\\\" ((\\\"org.me/foo\\\" ((\\\"inner\\\" 0))))) (\\\"alias-map\\\" ((\\\"me\\\" \\\"org.me\\\"))))\"\n  :type 'list\n  :group 'cider\n  :package-version '(cider . \"1.1.0\"))\n\n(defun cider--nrepl-format-code-request-map (&optional format-options)\n  \"Map to merge into requests that require code formatting.\nIf non-nil, FORMAT-OPTIONS specifies the options cljfmt will use to format\nthe code.  See `cider-format-code-options` for details.\"\n  (when format-options\n    (let* ((indents-dict (when (assoc \"indents\" format-options)\n                           (thread-last\n                             (cadr (assoc \"indents\" format-options))\n                             (map-pairs)\n                             (seq-mapcat #'identity)\n                             (apply #'nrepl-dict))))\n           (alias-map-dict (when (assoc \"alias-map\" format-options)\n                             (thread-last\n                               (cadr (assoc \"alias-map\" format-options))\n                               (map-pairs)\n                               (seq-mapcat #'identity)\n                               (apply #'nrepl-dict)))))\n      (thread-last\n        (map-merge 'list\n                   (when indents-dict\n                     `((\"indents\" ,indents-dict)))\n                   (when alias-map-dict\n                     `((\"alias-map\" ,alias-map-dict))))\n        (map-pairs)\n        (seq-mapcat #'identity)\n        (apply #'nrepl-dict)))))\n\n(defcustom cider-print-fn 'pprint\n  \"Sets the function to use for printing.\n\nnil – to defer to nREPL to choose the printing function.  This will use\nthe bound value of \\\\=`nrepl.middleware.print/*print-fn*\\\\=`, which\ndefaults to the equivalent of \\\\=`clojure.core/pr\\\\=`.\n\n`pr' – to use the equivalent of \\\\=`clojure.core/pr\\\\=`.\n\n`pprint' – to use \\\\=`clojure.pprint/pprint\\\\=` (this is the default).\n\n`fipp' – to use the Fast Idiomatic Pretty Printer, approximately 5-10x\nfaster than \\\\=`clojure.core/pprint\\\\=`.\n\n`puget' – to use Puget, which provides canonical serialization of data on\ntop of fipp, but at a slight performance cost.\n\n`zprint' – to use zprint, a fast and flexible alternative to the libraries\nmentioned above.\n\nAlternatively can be the namespace-qualified name of a Clojure var whose\nfunction takes three arguments: the object to print, the\n\\\\=`java.io.PrintWriter\\\\=` to print on, and a (possibly nil) map of\noptions.  If the function cannot be resolved, will behave as if set to\nnil.\"\n  :type '(choice (const nil)\n                 (const pr)\n                 (const pprint)\n                 (const fipp)\n                 (const puget)\n                 (const zprint)\n                 string)\n  :group 'cider\n  :package-version '(cider . \"0.21.0\"))\n\n(defcustom cider-print-options nil\n  \"A map of options that will be passed to `cider-print-fn'.\nHere's an example for `pprint':\n\n  '((\\\"length\\\" 50) (\\\"right-margin\\\" 70))\"\n  :type 'list\n  :group 'cider\n  :package-version '(cider . \"0.21.0\"))\n\n(make-obsolete-variable 'cider-pprint-fn 'cider-print-fn \"0.21\")\n(make-obsolete-variable 'cider-pprint-options 'cider-print-options \"0.21\")\n\n(defcustom cider-print-quota (* 1024 1024)\n  \"A hard limit on the number of bytes to return from any printing operation.\nSet to nil for no limit.\"\n  :type 'integer\n  :group 'cider\n  :package-version '(cider . \"0.21.0\"))\n\n(defcustom cider-print-buffer-size (* 4 1024)\n  \"The size in bytes of each value/output chunk when using print streaming.\nSmaller values mean smaller data chunks and faster feedback, but they also mean\nsmaller results that can be font-locked as Clojure in the REPL buffers, as only\na single chunk result can be font-locked.\n\nThe default value in nREPL is 1024.\"\n  :type 'integer\n  :group 'cider\n  :package-version '(cider . \"0.25.0\"))\n\n(defun cider--print-fn ()\n  \"Return the value to send in the nrepl.middleware.print/print slot.\"\n  (pcase cider-print-fn\n    (`pr     \"cider.nrepl.pprint/pr\")\n    (`pprint \"cider.nrepl.pprint/pprint\")\n    (`fipp   \"cider.nrepl.pprint/fipp-pprint\")\n    (`puget  \"cider.nrepl.pprint/puget-pprint\")\n    (`zprint \"cider.nrepl.pprint/zprint-pprint\")\n    (_ cider-print-fn)))\n\n(defvar cider--print-options-mapping\n  '((right-margin\n     ((fipp . width) (puget . width) (zprint . width)))\n    (length\n     ((fipp . print-length) (puget . print-length) (zprint . max-length)))\n    (level\n     ((fipp . print-level) (puget . print-level) (zprint . max-depth))))\n  \"A mapping of print option for the various supported print engines.\")\n\n(defun cider--print-option (name printer)\n  \"Convert the generic NAME to its PRINTER specific variant.\nE.g. pprint's right-margin would become width for fipp.\nThe function is useful when you want to generate dynamically\nprint options.\n\nNAME can be a string or a symbol.  PRINTER has to be a symbol.\nThe result will be a string.\"\n  (let* ((name (cider-maybe-intern name))\n         (result (cdr (assoc printer (cadr (assoc name cider--print-options-mapping))))))\n    (symbol-name (or result name))))\n\n(defun cider--nrepl-print-request-map (&optional right-margin)\n  \"Map to merge into requests that require pretty-printing.\nRIGHT-MARGIN specifies the maximum column-width of the printed result, and\nis included in the request if non-nil.\"\n  (let* ((width-option (cider--print-option \"right-margin\" cider-print-fn))\n         (print-options (thread-last\n                          (map-merge 'hash-table\n                                     `((,width-option ,right-margin))\n                                     cider-print-options)\n                          (map-pairs)\n                          (seq-mapcat #'identity)\n                          (apply #'nrepl-dict))))\n    (map-merge 'list\n               `((\"nrepl.middleware.print/stream?\" \"1\"))\n               (when cider-print-fn\n                 `((\"nrepl.middleware.print/print\" ,(cider--print-fn))))\n               (when cider-print-quota\n                 `((\"nrepl.middleware.print/quota\" ,cider-print-quota)))\n               (when cider-print-buffer-size\n                 `((\"nrepl.middleware.print/buffer-size\" ,cider-print-buffer-size)))\n               (unless (nrepl-dict-empty-p print-options)\n                 `((\"nrepl.middleware.print/options\" ,print-options))))))\n\n(defun cider--nrepl-pr-request-map ()\n  \"Map to merge into requests that do not require pretty printing.\"\n  (let ((print-options (thread-last\n                         cider-print-options\n                         (map-pairs)\n                         (seq-mapcat #'identity)\n                         (apply #'nrepl-dict))))\n    (map-merge 'list\n               `((\"nrepl.middleware.print/print\" \"cider.nrepl.pprint/pr\")\n                 (\"nrepl.middleware.print/stream?\" nil))\n               (unless (nrepl-dict-empty-p print-options)\n                 `((\"nrepl.middleware.print/options\" ,print-options)))\n               (when cider-print-quota\n                 `((\"nrepl.middleware.print/quota\" ,cider-print-quota))))))\n\n(defun cider--nrepl-content-type-map ()\n  \"Map to be merged into an eval request to make it use content-types.\"\n  '((\"content-type\" \"true\")))\n\n(defun cider-tooling-eval (input callback &optional ns connection)\n  \"Send the request INPUT to CONNECTION and register the CALLBACK.\nNS specifies the namespace in which to evaluate the request.  Requests\nevaluated in the tooling nREPL session don't affect the thread-local\nbindings of the primary eval nREPL session (e.g. this is not going to\nclobber *1/2/3).\"\n  ;; namespace forms are always evaluated in the \"user\" namespace\n  (nrepl-request:eval input\n                      callback\n                      (or connection (cider-current-repl nil 'ensure))\n                      ns nil nil nil 'tooling))\n\n(defun cider-sync-tooling-eval (input &optional ns connection)\n  \"Send the request INPUT to CONNECTION and evaluate in synchronously.\nNS specifies the namespace in which to evaluate the request.  Requests\nevaluated in the tooling nREPL session don't affect the thread-local\nbindings of the primary eval nREPL session (e.g. this is not going to\nclobber *1/2/3).\"\n  ;; namespace forms are always evaluated in the \"user\" namespace\n  (nrepl-sync-request:eval input\n                           (or connection (cider-current-repl nil 'ensure))\n                           ns\n                           'tooling))\n\n(defun cider-library-present-p (lib-ns)\n  \"Check whether LIB-NS is present.\nIf a certain well-known ns in a library is present we assume that library\nitself is present.\"\n  (nrepl-dict-get (cider-sync-tooling-eval (format \"(require '%s)\" lib-ns)) \"value\"))\n\n\f\n;;; Interrupt evaluation\n\n(defun cider-interrupt-handler (buffer)\n  \"Create an interrupt response handler for BUFFER.\"\n  (nrepl-make-response-handler buffer nil nil nil nil))\n\n(defun cider-interrupt ()\n  \"Interrupt any pending evaluations.\"\n  (interactive)\n  ;; FIXME: does this work correctly in cljc files?\n  (with-current-buffer (cider-current-repl nil 'ensure)\n    (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests)))\n      (dolist (request-id pending-request-ids)\n        (nrepl-request:interrupt\n         request-id\n         (cider-interrupt-handler (current-buffer))\n         (cider-current-repl))))))\n\n(defun cider-nrepl-eval-session ()\n  \"Return the eval nREPL session id of the current connection.\"\n  (with-current-buffer (cider-current-repl)\n    nrepl-session))\n\n(defun cider-nrepl-tooling-session ()\n  \"Return the tooling nREPL session id of the current connection.\"\n  (with-current-buffer (cider-current-repl)\n    nrepl-tooling-session))\n\n(defun cider--var-choice (var-info)\n  \"Prompt to choose from among multiple VAR-INFO candidates, if required.\nThis is needed only when the symbol queried is an unqualified host platform\nmethod, and multiple classes have a so-named member.  If VAR-INFO does not\ncontain a `candidates' key, it is returned as is.\"\n  (let ((candidates (nrepl-dict-get var-info \"candidates\")))\n    (if candidates\n        (let* ((classes (nrepl-dict-keys candidates))\n               (choice (completing-read \"Member in class: \" classes nil t))\n               (info (nrepl-dict-get candidates choice)))\n          info)\n      var-info)))\n\n;; FIXME: Now that nREPL supports a lookup op natively, we should\n;; remove this eval-based hack at some point.\n(defconst cider-info-form \"\n(do\n  (require 'clojure.java.io)\n  (require 'clojure.walk)\n\n  (if-let [var (resolve '%s)]\n    (let [info (meta var)]\n      (-> info\n          (update :ns str)\n          (update :name str)\n          (update :file (comp str clojure.java.io/resource))\n          (cond-> (:macro info) (update :macro str))\n          (cond-> (:special-form info) (update :special-form str))\n          (cond-> (:protocol info) (update :protocol str))\n          (cond-> (:arglists info) (update :arglists str))\n          (assoc :arglists-str (str (:arglists info)))\n          (clojure.walk/stringify-keys)))))\n\")\n\n(defun cider-fallback-eval:info (var)\n  \"Obtain VAR metadata via a regular eval.\nUsed only when the info nREPL middleware is not available.\"\n  (let* ((response (cider-sync-tooling-eval (format cider-info-form var)))\n         (var-info (nrepl-dict-from-hash (parseedn-read-str (nrepl-dict-get response \"value\")))))\n    var-info))\n\n(defun cider-var-info (var &optional all)\n  \"Return VAR's info as an alist with list cdrs.\nWhen multiple matching vars are returned you'll be prompted to select one,\nunless ALL is truthy.\"\n  (when (and var (not (string= var \"\")))\n    (let ((var-info (cond\n                     ((cider-nrepl-op-supported-p \"info\") (cider-sync-request:info var))\n                     ((cider-nrepl-op-supported-p \"lookup\") (cider-sync-request:lookup var))\n                     (t (cider-fallback-eval:info var)))))\n      (if all var-info (cider--var-choice var-info)))))\n\n(defun cider-member-info (class member)\n  \"Return the CLASS MEMBER's info as an alist with list cdrs.\"\n  (when (and class member)\n    (cider-sync-request:info nil class member)))\n\n\f\n;;; Requests\n\n(declare-function cider-load-file-handler \"cider-eval\")\n(defun cider-request:load-file (file-contents file-path file-name &optional connection callback)\n  \"Perform the nREPL \\\"load-file\\\" op.\nFILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be\nloaded.  If CONNECTION is nil, use `cider-current-repl'.  If CALLBACK\nis nil, use `cider-load-file-handler'.\"\n  (cider-nrepl-send-request `(\"op\" \"load-file\"\n                              \"file\" ,file-contents\n                              \"file-path\" ,file-path\n                              \"file-name\" ,file-name)\n                            (or callback\n                                (cider-load-file-handler (current-buffer)))\n                            connection))\n\n\f\n;;; Sync Requests\n\n(defcustom cider-filtered-namespaces-regexps\n  '(\"^cider.nrepl\" \"^refactor-nrepl\" \"^nrepl\")\n  \"List of regexps used to filter out some vars/symbols/namespaces.\nWhen nil, nothing is filtered out.  Otherwise, all namespaces matching any\nregexp from this list are dropped out of the \\\"ns-list\\\" op.  Also,\n\\\"apropos\\\" won't include vars from such namespaces.  This list is passed\non to the nREPL middleware without any pre-processing.  So the regexps have\nto be in Clojure format (with twice the number of backslashes) and not\nEmacs Lisp.\"\n  :type '(repeat string)\n  :safe #'listp\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p)\n  \"Send \\\"apropos\\\" request for regexp QUERY.\n\nOptional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P.\"\n  (let* ((query (replace-regexp-in-string \"[ \\t]+\" \".+\" query))\n         (response (cider-nrepl-send-sync-request\n                    `(\"op\" \"apropos\"\n                      \"ns\" ,(cider-current-ns)\n                      \"query\" ,query\n                      ,@(when search-ns `(\"search-ns\" ,search-ns))\n                      ,@(when docs-p '(\"docs?\" \"t\"))\n                      ,@(when privates-p '(\"privates?\" \"t\"))\n                      ,@(when case-sensitive-p '(\"case-sensitive?\" \"t\"))\n                      \"exclude-regexps\" ,cider-filtered-namespaces-regexps))))\n    (if (member \"apropos-regexp-error\" (nrepl-dict-get response \"status\"))\n        (user-error \"Invalid regexp: %s\" (nrepl-dict-get response \"error-msg\"))\n      (nrepl-dict-get response \"apropos-matches\"))))\n\n(defun cider-sync-request:classpath ()\n  \"Return a list of classpath entries.\"\n  (cider-ensure-op-supported \"classpath\")\n  (thread-first\n    '(\"op\" \"classpath\")\n    (cider-nrepl-send-sync-request)\n    (nrepl-dict-get \"classpath\")))\n\n(defun cider--get-abs-path (path project)\n  \"Resolve PATH to an absolute path relative to PROJECT.\nDo nothing if PATH is already absolute.\"\n  (if (not (file-name-absolute-p path))\n      (expand-file-name path project)\n    path))\n\n(defun cider-fallback-eval:classpath ()\n  \"Return a list of classpath entries using eval.\n\nSometimes the classpath contains entries like src/main and we need to\nresolve those to absolute paths.\"\n  (when (cider-runtime-clojure-p)\n    (let ((classpath (thread-first\n                       \"(seq (.split (System/getProperty \\\"java.class.path\\\") \\\":\\\"))\"\n                       (cider-sync-tooling-eval)\n                       (nrepl-dict-get \"value\")\n                       read))\n          (project (clojure-project-dir)))\n      (mapcar (lambda (path) (cider--get-abs-path path project)) classpath))))\n\n(defun cider-classpath-entries ()\n  \"Return a list of classpath entries.\"\n  (seq-map #'expand-file-name ; normalize filenames for e.g. Windows\n           (if (cider-nrepl-op-supported-p \"classpath\")\n               (cider-sync-request:classpath)\n             (cider-fallback-eval:classpath))))\n\n(defun cider-sync-request:completion (prefix)\n  \"Return a list of completions for PREFIX using nREPL's \\\"completion\\\" op.\"\n  (when-let* ((dict (thread-first `(\"op\" \"completions\"\n                                    \"ns\" ,(cider-current-ns)\n                                    \"prefix\" ,prefix)\n                                  (cider-nrepl-send-sync-request (cider-current-repl)\n                                                                 'abort-on-input))))\n    (nrepl-dict-get dict \"completions\")))\n\n(defun cider-sync-request:complete (prefix context)\n  \"Return a list of completions for PREFIX using nREPL's \\\"complete\\\" op.\nCONTEXT represents a completion context for compliment.\"\n  (when-let* ((dict (thread-first `(\"op\" \"complete\"\n                                    \"ns\" ,(cider-current-ns)\n                                    \"prefix\" ,prefix\n                                    \"context\" ,context\n                                    ,@(when cider-enhanced-cljs-completion-p '(\"enhanced-cljs-completion?\" \"t\")))\n                                  (cider-nrepl-send-sync-request (cider-current-repl)\n                                                                 'abort-on-input))))\n    (nrepl-dict-get dict \"completions\")))\n\n(defun cider-sync-request:complete-flush-caches ()\n  \"Send \\\"complete-flush-caches\\\" op to flush Compliment's caches.\"\n  (cider-nrepl-send-sync-request (list \"op\" \"complete-flush-caches\"\n                                       \"session\" (cider-nrepl-eval-session))\n                                 nil\n                                 'abort-on-input))\n\n(defun cider-sync-request:info (symbol &optional class member)\n  \"Send \\\"info\\\" op with parameters SYMBOL or CLASS and MEMBER.\"\n  (let ((var-info (thread-first `(\"op\" \"info\"\n                                  \"ns\" ,(cider-current-ns)\n                                  ,@(when symbol `(\"sym\" ,symbol))\n                                  ,@(when class `(\"class\" ,class))\n                                  ,@(when member `(\"member\" ,member)))\n                                (cider-nrepl-send-sync-request (cider-current-repl)))))\n    (if (member \"no-info\" (nrepl-dict-get var-info \"status\"))\n        nil\n      var-info)))\n\n(defun cider-sync-request:lookup (symbol &optional lookup-fn)\n  \"Send \\\"lookup\\\" op request with parameters SYMBOL and LOOKUP-FN.\"\n  (let ((var-info (thread-first `(\"op\" \"lookup\"\n                                  \"ns\" ,(cider-current-ns)\n                                  ,@(when symbol `(\"sym\" ,symbol))\n                                  ,@(when lookup-fn `(\"lookup-fn\" ,lookup-fn)))\n                                (cider-nrepl-send-sync-request (cider-current-repl)))))\n    (if (member \"lookup-error\" (nrepl-dict-get var-info \"status\"))\n        nil\n      (nrepl-dict-get var-info \"info\"))))\n\n(defun cider-sync-request:eldoc (symbol &optional class member)\n  \"Send \\\"eldoc\\\" op with parameters SYMBOL or CLASS and MEMBER.\"\n  (when-let* ((eldoc (thread-first `(\"op\" \"eldoc\"\n                                     \"ns\" ,(cider-current-ns)\n                                     ,@(when symbol `(\"sym\" ,symbol))\n                                     ,@(when class `(\"class\" ,class))\n                                     ,@(when member `(\"member\" ,member)))\n                                   (cider-nrepl-send-sync-request (cider-current-repl)\n                                                                  'abort-on-input))))\n    (if (member \"no-eldoc\" (nrepl-dict-get eldoc \"status\"))\n        nil\n      eldoc)))\n\n(defun cider-sync-request:eldoc-datomic-query (symbol)\n  \"Send \\\"eldoc-datomic-query\\\" op with parameter SYMBOL.\"\n  (when-let* ((eldoc (thread-first `(\"op\" \"eldoc-datomic-query\"\n                                     \"ns\" ,(cider-current-ns)\n                                     ,@(when symbol `(\"sym\" ,symbol)))\n                                   (cider-nrepl-send-sync-request nil 'abort-on-input))))\n    (if (member \"no-eldoc\" (nrepl-dict-get eldoc \"status\"))\n        nil\n      eldoc)))\n\n(defun cider-sync-request:spec-list (&optional filter-regex)\n  \"Get a list of the available specs in the registry.\nOptional argument FILTER-REGEX filters specs.  By default, all specs are\nreturned.\"\n  (setq filter-regex (or filter-regex \"\"))\n  (thread-first `(\"op\" \"spec-list\"\n                  \"filter-regex\" ,filter-regex\n                  \"ns\" ,(cider-current-ns))\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"spec-list\")))\n\n(defun cider-sync-request:spec-form (spec)\n  \"Get SPEC's form from registry.\"\n  (thread-first `(\"op\" \"spec-form\"\n                  \"spec-name\" ,spec\n                  \"ns\" ,(cider-current-ns))\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"spec-form\")))\n\n(defun cider-sync-request:spec-example (spec)\n  \"Get an example for SPEC.\"\n  (thread-first `(\"op\" \"spec-example\"\n                  \"spec-name\" ,spec)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"spec-example\")))\n\n(defun cider-sync-request:ns-list ()\n  \"Get a list of the available namespaces.\"\n  (thread-first `(\"op\" \"ns-list\"\n                  \"exclude-regexps\" ,cider-filtered-namespaces-regexps)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"ns-list\")))\n\n(defun cider-sync-request:ns-vars (ns)\n  \"Get a list of the vars in NS.\"\n  (thread-first `(\"op\" \"ns-vars\"\n                  \"ns\" ,ns)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"ns-vars\")))\n\n(defun cider-sync-request:ns-path (ns)\n  \"Get the path to the file containing NS.\"\n  (thread-first `(\"op\" \"ns-path\"\n                  \"ns\" ,ns)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"path\")))\n\n(defun cider-sync-request:ns-vars-with-meta (ns)\n  \"Get a map of the vars in NS to its metadata information.\"\n  (thread-first `(\"op\" \"ns-vars-with-meta\"\n                  \"ns\" ,ns)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"ns-vars-with-meta\")))\n\n(defun cider-sync-request:private-ns-vars-with-meta (ns)\n  \"Get a map of the vars in NS to its metadata information.\"\n  (thread-first `(\"op\" \"ns-vars-with-meta\"\n                  \"ns\" ,ns\n                  \"var-query\" ,(nrepl-dict \"private?\" \"t\"\n                                           \"include-meta-key\" '(\"private\")))\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"ns-vars-with-meta\")))\n\n(defun cider-sync-request:ns-load-all ()\n  \"Load all project namespaces.\"\n  (thread-first '(\"op\" \"ns-load-all\")\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"loaded-ns\")))\n\n(defun cider-sync-request:resource (name)\n  \"Perform nREPL \\\"resource\\\" op with resource name NAME.\"\n  (thread-first `(\"op\" \"resource\"\n                  \"name\" ,name)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"resource-path\")))\n\n(defun cider-sync-request:resources-list ()\n  \"Return a list of all resources on the classpath.\nThe result entries are relative to the classpath.\"\n  (when-let* ((resources (thread-first '(\"op\" \"resources-list\")\n                                       (cider-nrepl-send-sync-request)\n                                       (nrepl-dict-get \"resources-list\"))))\n    (seq-map (lambda (resource) (nrepl-dict-get resource \"relpath\")) resources)))\n\n(defun cider-sync-request:fn-refs (ns sym)\n  \"Return a list of functions that reference the function identified by NS and SYM.\"\n  (cider-ensure-op-supported \"fn-refs\")\n  (thread-first `(\"op\" \"fn-refs\"\n                  \"ns\" ,ns\n                  \"sym\" ,sym)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"fn-refs\")))\n\n(defun cider-sync-request:fn-deps (ns sym)\n  \"Return a list of function deps for the function identified by NS and SYM.\"\n  (cider-ensure-op-supported \"fn-deps\")\n  (thread-first `(\"op\" \"fn-deps\"\n                  \"ns\" ,ns\n                  \"sym\" ,sym)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"fn-deps\")))\n\n(defun cider-sync-request:format-code (code &optional format-options)\n  \"Perform nREPL \\\"format-code\\\" op with CODE.\nFORMAT-OPTIONS is an optional configuration map for cljfmt.\"\n  (let* ((request `(\"op\" \"format-code\"\n                    \"options\" ,(cider--nrepl-format-code-request-map format-options)\n                    \"code\" ,code))\n         (response (cider-nrepl-send-sync-request request))\n         (err (nrepl-dict-get response \"err\")))\n    (when err\n      ;; err will be a stacktrace with a first line that looks like:\n      ;; \"clojure.lang.ExceptionInfo: Unmatched delimiter ]\"\n      (error (car (split-string err \"\\n\"))))\n    (nrepl-dict-get response \"formatted-code\")))\n\n(defun cider-sync-request:format-edn (edn right-margin)\n  \"Perform \\\"format-edn\\\" op with EDN and RIGHT-MARGIN.\"\n  (let* ((request (thread-last\n                    (map-merge 'list\n                               `((\"op\" \"format-edn\")\n                                 (\"edn\" ,edn))\n                               (cider--nrepl-print-request-map right-margin))\n                    (seq-mapcat #'identity)))\n         (response (cider-nrepl-send-sync-request request))\n         (err (nrepl-dict-get response \"err\")))\n    (when err\n      ;; err will be a stacktrace with a first line that looks like:\n      ;; \"clojure.lang.ExceptionInfo: Unmatched delimiter ]\"\n      (error (car (split-string err \"\\n\"))))\n    (nrepl-dict-get response \"formatted-edn\")))\n\n;;; Dealing with input\n;; TODO: Replace this with some nil handler.\n(defun cider-stdin-handler (&optional _buffer)\n  \"Make a stdin response handler for _BUFFER.\"\n  (nrepl-make-response-handler (current-buffer)\n                               (lambda (_buffer _value))\n                               (lambda (_buffer _out))\n                               (lambda (_buffer _err))\n                               nil))\n\n(defun cider-need-input (buffer)\n  \"Handle an need-input request from BUFFER.\"\n  (with-current-buffer buffer\n    (let ((map (make-sparse-keymap)))\n      (set-keymap-parent map minibuffer-local-map)\n      (define-key map (kbd \"C-c C-c\") #'abort-recursive-edit)\n      (let ((stdin (condition-case nil\n                       (concat (read-from-minibuffer \"Stdin: \" nil map) \"\\n\")\n                     (quit nil))))\n        (nrepl-request:stdin stdin\n                             (cider-stdin-handler buffer)\n                             (cider-current-repl))))))\n\n(provide 'cider-client)\n\n;;; cider-client.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-clojuredocs.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53480861,"end":53480905},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53480905},"to":{"change":3,"start":53474460,"end":53474460},"introduced_by":3}],"inode":{"change":3,"pos":53474460}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53474460},"to":{"change":3,"start":53474461,"end":53480860},"introduced_by":3}],"inode":{"change":3,"pos":53474460}},"content":[{"Del":";;; cider-clojuredocs.el --- ClojureDocs integration -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; A few commands for ClojureDocs documentation lookup.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-common)\n(require 'subr-x)\n(require 'cider-popup)\n\n(require 'nrepl-dict)\n\n(require 'url-vars)\n\n(defconst cider-clojuredocs-url \"https://clojuredocs.org/\")\n\n(defconst cider-clojuredocs-buffer \"*cider-clojuredocs*\")\n\n(defun cider-sync-request:clojuredocs-lookup (ns sym)\n  \"Perform nREPL \\\"resource\\\" op with NS and SYM.\"\n  (thread-first `(\"op\" \"clojuredocs-lookup\"\n                  \"ns\" ,ns\n                  \"sym\" ,sym)\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"clojuredocs\")))\n\n(defun cider-sync-request:clojuredocs-refresh ()\n  \"Refresh the ClojureDocs cache.\"\n  (thread-first '(\"op\" \"clojuredocs-refresh-cache\")\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"status\")))\n\n(defun cider-clojuredocs-replace-special (name)\n  \"Convert the dashes in NAME to a ClojureDocs friendly format.\nWe need to handle \\\"?\\\", \\\".\\\", \\\"..\\\" and \\\"/\\\".\"\n  (thread-last\n    name\n    (replace-regexp-in-string \"\\\\?\" \"_q\")\n    (replace-regexp-in-string \"\\\\(\\\\.+\\\\)\" \"_\\\\1\")\n    (replace-regexp-in-string \"/\" \"fs\")))\n\n(defun cider-clojuredocs-url (name ns)\n  \"Generate a ClojureDocs url from NAME and NS.\"\n  (let ((base-url cider-clojuredocs-url))\n    (when (and name ns)\n      (concat base-url ns \"/\" (cider-clojuredocs-replace-special name)))))\n\n(defun cider-clojuredocs-web-lookup (sym)\n  \"Open the ClojureDocs documentation for SYM in a web browser.\"\n  (if-let* ((var-info (cider-var-info sym)))\n      (let ((name (nrepl-dict-get var-info \"name\"))\n            (ns (nrepl-dict-get var-info \"ns\")))\n        (browse-url (cider-clojuredocs-url name ns)))\n    (error \"Symbol %s not resolved\" sym)))\n\n;;;###autoload\n(defun cider-clojuredocs-web (&optional arg)\n  \"Open ClojureDocs documentation in the default web browser.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\"\n  (interactive \"P\")\n  (funcall (cider-prompt-for-symbol-function arg)\n           \"ClojureDocs doc for\"\n           #'cider-clojuredocs-web-lookup))\n\n;;;###autoload\n(defun cider-clojuredocs-refresh-cache ()\n  \"Refresh the ClojureDocs cache.\"\n  (interactive)\n  (let ((result (cider-sync-request:clojuredocs-refresh)))\n    (if (member \"ok\" result)\n        (message \"ClojureDocs cache refreshed successfully\")\n      (message \"An error occurred while trying to refresh the ClojureDocs cache\"))))\n\n(defun cider-create-clojuredocs-buffer (content)\n  \"Create a new ClojureDocs buffer with CONTENT.\"\n  (with-current-buffer (cider-popup-buffer cider-clojuredocs-buffer t)\n    (read-only-mode -1)\n    (set-syntax-table clojure-mode-syntax-table)\n    (local-set-key (kbd \"C-c C-d C-c\") 'cider-clojuredocs)\n    (insert content)\n    (cider-popup-buffer-mode 1)\n    (view-mode 1)\n    (goto-char (point-min))\n    (current-buffer)))\n\n(defun cider-clojuredocs--content (dict)\n  \"Generate a nice string from DICT.\"\n  (with-temp-buffer\n    (insert \"= \" (nrepl-dict-get dict \"ns\") \"/\" (nrepl-dict-get dict \"name\") \"\\n\\n\")\n    (let ((arglists (nrepl-dict-get dict \"arglists\")))\n      (dolist (arglist arglists)\n        (insert (format \" [%s]\\n\" arglist)))\n      (insert \"\\n\")\n      (insert (nrepl-dict-get dict \"doc\"))\n      (insert \"\\n\"))\n    (insert \"\\n== See Also\\n\\n\")\n    (if-let ((see-alsos (nrepl-dict-get dict \"see-alsos\")))\n        (dolist (see-also see-alsos)\n          (insert-text-button (format \"* %s\\n\" see-also)\n                              'sym see-also\n                              'action (lambda (btn)\n                                        (cider-clojuredocs-lookup (button-get btn 'sym)))\n                              'help-echo (format \"Press Enter or middle click to jump to %s\" see-also)))\n      (insert \"Not available\\n\"))\n    (insert \"\\n== Examples\\n\\n\")\n    (if-let ((examples (nrepl-dict-get dict \"examples\")))\n        (dolist (example examples)\n          (insert (cider-font-lock-as-clojure example))\n          (insert \"\\n-------------------------------------------------\\n\"))\n      (insert \"Not available\\n\"))\n    (insert \"\\n== Notes\\n\\n\")\n    (if-let ((notes (nrepl-dict-get dict \"notes\")))\n        (dolist (note notes)\n          (insert note)\n          (insert \"\\n-------------------------------------------------\\n\"))\n      (insert \"Not available\\n\"))\n    (buffer-string)))\n\n(defun cider-clojuredocs-lookup (sym)\n  \"Look up the ClojureDocs documentation for SYM.\"\n  (let ((docs (cider-sync-request:clojuredocs-lookup (cider-current-ns) sym)))\n    (pop-to-buffer (cider-create-clojuredocs-buffer (cider-clojuredocs--content docs)))\n    ;; highlight the symbol in question in the docs buffer\n    (highlight-regexp\n     (regexp-quote\n      (or (cadr (split-string sym \"/\"))\n          sym))\n     'bold)))\n\n;;;###autoload\n(defun cider-clojuredocs (&optional arg)\n  \"Open ClojureDocs documentation in a popup buffer.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\"\n  (interactive \"P\")\n  (when (derived-mode-p 'clojurescript-mode)\n    (user-error \"`cider-clojuredocs' doesn't support ClojureScript\"))\n  (funcall (cider-prompt-for-symbol-function arg)\n           \"ClojureDocs doc for\"\n           #'cider-clojuredocs-lookup))\n\n(provide 'cider-clojuredocs)\n\n;;; cider-clojuredocs.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-common.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53474419,"end":53474458},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53474458},"to":{"change":3,"start":53454875,"end":53454875},"introduced_by":3}],"inode":{"change":3,"pos":53454875}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53454875},"to":{"change":3,"start":53454876,"end":53474418},"introduced_by":3}],"inode":{"change":3,"pos":53454875}},"content":[{"Del":";;; cider-common.el --- Common use functions         -*- lexical-binding: t; -*-\n\n;; Copyright © 2015-2022  Artur Malabarba\n\n;; Author: Artur Malabarba \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;; Common functions that are useful in both Clojure buffers and REPL\n;; buffers.\n\n;;; Code:\n\n(require 'subr-x)\n(require 'nrepl-dict)\n(require 'cider-util)\n(require 'xref)\n(require 'tramp)\n\n(defcustom cider-prompt-for-symbol nil\n  \"Controls when to prompt for symbol when a command requires one.\n\nWhen non-nil, always prompt, and use the symbol at point as the default\nvalue at the prompt.\n\nWhen nil, attempt to use the symbol at point for the command, and only\nprompt if that throws an error.\"\n  :type '(choice (const :tag \"always\" t)\n                 (const :tag \"dwim\" nil))\n  :group 'cider\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-special-mode-truncate-lines t\n  \"If non-nil, contents of CIDER's special buffers will be line-truncated.\nShould be set before loading CIDER.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defun cider--should-prompt-for-symbol (&optional invert)\n  \"Return the value of the variable `cider-prompt-for-symbol'.\nOptionally invert the value, if INVERT is truthy.\"\n  (if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol))\n\n(defun cider-prompt-for-symbol-function (&optional invert)\n  \"Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy.\nOtherwise attempt to use the symbol at point for the command, and only\nprompt if that throws an error.\n\nINVERT inverts the semantics of the function `cider--should-prompt-for-symbol'.\"\n  (if (cider--should-prompt-for-symbol invert)\n      #'cider-read-symbol-name\n    #'cider-try-symbol-at-point))\n\n(defun cider--kw-to-symbol (kw)\n  \"Convert the keyword KW to a symbol.\"\n  (when kw\n    (replace-regexp-in-string \"\\\\`:+\" \"\" kw)))\n\n;;; Minibuffer\n(defvar cider-minibuffer-history '()\n  \"History list of expressions read from the minibuffer.\")\n\n(defvar cider-minibuffer-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map minibuffer-local-map)\n    (define-key map (kbd \"TAB\") #'complete-symbol)\n    (define-key map (kbd \"M-TAB\") #'complete-symbol)\n    map)\n  \"Minibuffer keymap used for reading Clojure expressions.\")\n\n(declare-function cider-complete-at-point \"cider-completion\")\n(declare-function cider-eldoc \"cider-eldoc\")\n(defun cider-read-from-minibuffer (prompt &optional value)\n  \"Read a string from the minibuffer, prompting with PROMPT.\nIf VALUE is non-nil, it is inserted into the minibuffer as initial-input.\nPROMPT need not end with \\\": \\\". If it doesn't, VALUE is displayed on the\nprompt as a default value (used if the user doesn't type anything) and is\nnot used as initial input (input is left empty).\"\n  (minibuffer-with-setup-hook\n      (lambda ()\n        (set-syntax-table clojure-mode-syntax-table)\n        (add-hook 'completion-at-point-functions\n                  #'cider-complete-at-point nil t)\n        (setq-local eldoc-documentation-function #'cider-eldoc)\n        (run-hooks 'eval-expression-minibuffer-setup-hook))\n    (let* ((has-colon (string-match \": \\\\'\" prompt))\n           (input (read-from-minibuffer (cond\n                                         (has-colon prompt)\n                                         (value (format \"%s (default %s): \" prompt value))\n                                         (t (format \"%s: \" prompt)))\n                                        (when has-colon value) ; initial-input\n                                        cider-minibuffer-map nil\n                                        'cider-minibuffer-history\n                                        (unless has-colon value)))) ; default-value\n      (if (and (equal input \"\") value (not has-colon))\n          value\n        input))))\n\n(defun cider-read-symbol-name (prompt callback)\n  \"Read a symbol name using PROMPT with a default of the one at point.\nUse CALLBACK as the completing read var callback.\"\n  (funcall callback (cider-read-from-minibuffer\n                     prompt\n                     ;; if the thing at point is a keyword we treat it as symbol\n                     (cider--kw-to-symbol (cider-symbol-at-point 'look-back)))))\n\n(defun cider-try-symbol-at-point (prompt callback)\n  \"Call CALLBACK with symbol at point.\nOn failure, read a symbol name using PROMPT and call CALLBACK with that.\"\n  (condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back)))\n    ('error (funcall callback (cider-read-from-minibuffer prompt)))))\n\n(declare-function cider-mode \"cider-mode\")\n\n(defcustom cider-jump-to-pop-to-buffer-actions\n  '((display-buffer-reuse-window display-buffer-same-window))\n  \"Determines what window `cider-jump-to` uses.\nThe value is passed as the `action` argument to `pop-to-buffer`.\n\nThe default value means:\n\n- If the target file is already visible in a window, reuse it (switch to it).\n- Otherwise, open the target buffer in the current window.\n\nFor further details, see https://docs.cider.mx/cider/config/basic_config.html#control-what-window-to-use-when-jumping-to-a-definition\"\n  :type 'sexp\n  :group 'cider\n  :package-version '(cider . \"0.24.0\"))\n\n(defun cider-jump-to (buffer &optional pos other-window)\n  \"Push current point onto marker ring, and jump to BUFFER and POS.\nPOS can be either a number, a cons, or a symbol.\nIf a number, it is the character position (the point).\nIf a cons, it specifies the position as (LINE . COLUMN).  COLUMN can be nil.\nIf a symbol, `cider-jump-to' searches for something that looks like the\nsymbol's definition in the file.\nIf OTHER-WINDOW is non-nil don't reuse current window.\"\n  (with-no-warnings\n    (xref-push-marker-stack))\n  (if other-window\n      (pop-to-buffer buffer 'display-buffer-pop-up-window)\n    (pop-to-buffer buffer cider-jump-to-pop-to-buffer-actions))\n  (with-current-buffer buffer\n    (widen)\n    (goto-char (point-min))\n    (cider-mode +1)\n    (let ((status\n           (cond\n            ;; Line-column specification.\n            ((consp pos)\n             (forward-line (1- (or (car pos) 1)))\n             (if (cdr pos)\n                 (move-to-column (cdr pos))\n               (back-to-indentation)))\n            ;; Point specification.\n            ((numberp pos)\n             (goto-char pos))\n            ;; Symbol or string.\n            (pos\n             ;; Try to find (def full-name ...).\n             (if (or (save-excursion\n                       (search-forward-regexp (format \"(def.*\\\\s-\\\\(%s\\\\)\" (regexp-quote pos))\n                                              nil 'noerror))\n                     (let ((name (replace-regexp-in-string \".*/\" \"\" pos)))\n                       ;; Try to find (def name ...).\n                       (or (save-excursion\n                             (search-forward-regexp (format \"(def.*\\\\s-\\\\(%s\\\\)\" (regexp-quote name))\n                                                    nil 'noerror))\n                           ;; Last resort, just find the first occurrence of `name'.\n                           (save-excursion\n                             (search-forward name nil 'noerror)))))\n                 (goto-char (match-beginning 0))\n               (message \"Can't find %s in %s\" pos (buffer-file-name))\n               'not-found))\n            (t 'not-found))))\n      (unless (eq status 'not-found)\n        ;; Make sure the location we jump to is centered within the target window\n        (recenter)))))\n\n(defun cider--find-buffer-for-file (file)\n  \"Return a buffer visiting FILE.\nIf FILE is a temp buffer name, return that buffer.\"\n  (if (string-prefix-p \"*\" file)\n      file\n    (and file\n         (not (cider--tooling-file-p file))\n         (cider-find-file file))))\n\n(defun cider--jump-to-loc-from-info (info &optional other-window)\n  \"Jump to location give by INFO.\nINFO object is returned by `cider-var-info' or `cider-member-info'.\nOTHER-WINDOW is passed to `cider-jump-to'.\"\n  (let* ((line (nrepl-dict-get info \"line\"))\n         (file (nrepl-dict-get info \"file\"))\n         (name (nrepl-dict-get info \"name\"))\n         ;; the filename might actually be a REPL buffer name\n         (buffer (cider--find-buffer-for-file file)))\n    (if buffer\n        (cider-jump-to buffer (if line (cons line nil) name) other-window)\n      (error \"No source location\"))))\n\n(declare-function url-filename \"url-parse\" (cl-x) t)\n\n(defun cider--url-to-file (url)\n  \"Return the filename from the resource URL.\nUses `url-generic-parse-url' to parse the url.  The filename is extracted and\nthen url decoded.  If the decoded filename has a Windows device letter followed\nby a colon immediately after the leading '/' then the leading '/' is dropped to\ncreate a valid path.\"\n  (let ((filename (url-unhex-string (url-filename (url-generic-parse-url url)))))\n    (if (string-match \"^/\\\\([a-zA-Z]:/.*\\\\)\" filename)\n        (match-string 1 filename)\n      filename)))\n\n(defun cider-make-tramp-prefix (method user host)\n  \"Constructs a Tramp file prefix from METHOD, USER, HOST.\nIt originated from Tramp's `tramp-make-tramp-file-name'.  The original be\nforced to make full file name with `with-parsed-tramp-file-name', not providing\nprefix only option.\"\n  (concat tramp-prefix-format\n          (unless (zerop (length method))\n            (concat method tramp-postfix-method-format))\n          (unless (zerop (length user))\n            (concat user tramp-postfix-user-format))\n          (when host\n            (if (string-match tramp-ipv6-regexp host)\n                (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)\n              host))\n          tramp-postfix-host-format))\n\n(defun cider-tramp-prefix (&optional buffer)\n  \"Use the filename for BUFFER to determine a tramp prefix.\nDefaults to the current buffer.  Return the tramp prefix, or nil\nif BUFFER is local.\"\n  (let* ((buffer (or buffer (current-buffer)))\n         (name (or (buffer-file-name buffer)\n                   (with-current-buffer buffer\n                     default-directory))))\n    (when (tramp-tramp-file-p name)\n      (with-parsed-tramp-file-name name v\n        (with-no-warnings\n          (cider-make-tramp-prefix v-method v-user v-host))))))\n\n(defun cider--client-tramp-filename (name &optional buffer)\n  \"Return the tramp filename for path NAME relative to BUFFER.\nIf BUFFER has a tramp prefix, it will be added as a prefix to NAME.\nIf the resulting path is an existing tramp file, it returns the path,\notherwise, nil.\"\n  (let* ((buffer (or buffer (current-buffer)))\n         (name (replace-regexp-in-string \"^file:\" \"\" name))\n         (name (concat (cider-tramp-prefix buffer) name)))\n    (if (and (tramp-tramp-file-p name)\n             (tramp-handle-file-exists-p name))\n        name)))\n\n(defun cider--server-filename (name)\n  \"Return the nREPL server-relative filename for NAME.\"\n  (if (tramp-tramp-file-p name)\n      (with-parsed-tramp-file-name name nil\n        localname)\n    name))\n\n(defcustom cider-path-translations nil\n  \"Alist of path prefixes to path prefixes.\nUseful to intercept the location of a path in a container (or virtual\nmachine) and translate to the original location.  If your project is located\nat \\\"~/projects/foo\\\" and the src directory of foo is mounted at \\\"/src\\\"\nin the container, the alist would be `((\\\"/src\\\" \\\"~/projects/foo/src\\\")).\"\n  :type '(alist :key-type string :value-type string)\n  :group 'cider\n  :package-version '(cider . \"0.23.0\"))\n\n(defun cider--translate-path (path direction)\n  \"Attempt to translate the PATH in the given DIRECTION.\nLooks at `cider-path-translations' for (container . host) alist of path\nprefixes and translates PATH from container to host or vice-versa depending on\nwhether DIRECTION is 'from-nrepl or 'to-nrepl.\"\n  (seq-let [from-fn to-fn path-fn] (cond ((eq direction 'from-nrepl) '(car cdr identity))\n                                         ((eq direction 'to-nrepl) '(cdr car expand-file-name)))\n    (let ((path (funcall path-fn path)))\n      (seq-some (lambda (translation)\n                  (let ((prefix (file-name-as-directory (expand-file-name (funcall from-fn translation)))))\n                    (when (string-prefix-p prefix path)\n                      (replace-regexp-in-string (format \"^%s\" (regexp-quote prefix))\n                                                (file-name-as-directory\n                                                 (expand-file-name (funcall to-fn translation)))\n                                                path))))\n                cider-path-translations))))\n\n(defun cider--translate-path-from-nrepl (path)\n  \"Attempt to translate the nREPL PATH to a local path.\"\n  (cider--translate-path path 'from-nrepl))\n\n(defun cider--translate-path-to-nrepl (path)\n  \"Attempt to translate the local PATH to an nREPL path.\"\n  (cider--translate-path (expand-file-name path) 'to-nrepl))\n\n(defvar cider-from-nrepl-filename-function\n  (with-no-warnings\n    (lambda (path)\n      (let ((path* (if (eq system-type 'cygwin)\n                       (cygwin-convert-file-name-from-windows path)\n                     path)))\n        (or (cider--translate-path-from-nrepl path*) path*))))\n  \"Function to translate nREPL namestrings to Emacs filenames.\")\n\n(defcustom cider-prefer-local-resources nil\n  \"Prefer local resources to remote (tramp) ones when both are available.\"\n  :type 'boolean\n  :group 'cider)\n\n(defun cider--file-path (path)\n  \"Return PATH's local or tramp path using `cider-prefer-local-resources'.\nIf no local or remote file exists, return nil.\"\n  (let* ((local-path (funcall cider-from-nrepl-filename-function path))\n         (tramp-path (and local-path (cider--client-tramp-filename local-path))))\n    (cond ((equal local-path \"\") \"\")\n          ((and cider-prefer-local-resources (file-exists-p local-path))\n           local-path)\n          ((and tramp-path (file-exists-p tramp-path))\n           tramp-path)\n          ((and local-path (file-exists-p local-path))\n           local-path))))\n\n(declare-function archive-extract \"arc-mode\")\n(declare-function archive-zip-extract \"arc-mode\")\n\n(defun cider-find-file (url)\n  \"Return a buffer visiting the file URL if it exists, or nil otherwise.\nIf URL has a scheme prefix, it must represent a fully-qualified file path\nor an entry within a zip/jar archive.  If AVFS (archive virtual file\nsystem; see online docs) is mounted the archive entry is opened inside the\nAVFS directory, otherwise the entry is archived into a temporary read-only\nbuffer.  If URL doesn't contain a scheme prefix and is an absolute path, it\nis treated as such.  Finally, if URL is relative, it is expanded within each\nof the open Clojure buffers till an existing file ending with URL has been\nfound.\"\n  (require 'arc-mode)\n  (cond ((string-match \"^file:\\\\(.+\\\\)\" url)\n         (when-let* ((file (cider--url-to-file (match-string 1 url)))\n                     (path (cider--file-path file)))\n           (find-file-noselect path)))\n        ((string-match \"^\\\\(jar\\\\|zip\\\\):\\\\(file:.+\\\\)!/\\\\(.+\\\\)\" url)\n         (when-let* ((entry (match-string 3 url))\n                     (file (cider--url-to-file (match-string 2 url)))\n                     (path (cider--file-path file))\n                     (name (format \"%s:%s\" path entry))\n                     (avfs (format \"%s%s#uzip/%s\"\n                                   (expand-file-name (or (getenv \"AVFSBASE\")  \"~/.avfs/\"))\n                                   path entry)))\n           (cond\n            ;; 1) use avfs\n            ((file-exists-p avfs)\n             (find-file-noselect avfs))\n            ;; 2) already uncompressed\n            ((find-buffer-visiting name))\n            ;; 3) on remotes use Emacs built-in archiving\n            ((tramp-tramp-file-p path)\n             (find-file path)\n             (goto-char (point-min))\n             ;; anchor to eol to prevent eg. clj matching cljs.\n             (re-search-forward (concat entry \"$\"))\n             (let ((archive-buffer (current-buffer)))\n               (archive-extract)\n               (kill-buffer archive-buffer))\n             (current-buffer))\n            ;; 4) Use external zip program to extract a single file\n            (t\n             (with-current-buffer (generate-new-buffer\n                                   (file-name-nondirectory entry))\n               ;; Use appropriate coding system for bytes read from unzip cmd to\n               ;; display Emacs native newlines regardless of whether the file\n               ;; uses unix LF or dos CRLF line endings.\n               ;; It's important to avoid spurious CR characters, which may\n               ;; appear as `^M', because they can confuse clojure-mode's symbol\n               ;; detection, e.g. `clojure-find-ns', and break `cider-find-var'.\n               ;; `clojure-find-ns' uses Emacs' (thing-at-point 'symbol) as\n               ;; part of identifying a file's namespace, and when a file\n               ;; isn't decoded properly, namespaces can be reported as\n               ;; `my.lib^M' which `cider-find-var' won't know what to do with.\n               (let ((coding-system-for-read 'prefer-utf-8))\n                 (archive-zip-extract path entry))\n               (set-visited-file-name name)\n               (setq-local default-directory (file-name-directory path))\n               (setq-local buffer-read-only t)\n               (set-buffer-modified-p nil)\n               (set-auto-mode)\n               (current-buffer))))))\n        (t (if-let* ((path (cider--file-path url)))\n               (find-file-noselect path)\n             (unless (file-name-absolute-p url)\n               (let ((cider-buffers (cider-util--clojure-buffers))\n                     (url (file-name-nondirectory url)))\n                 (or (cl-loop for bf in cider-buffers\n                              for path = (with-current-buffer bf\n                                           (expand-file-name url))\n                              if (and path (file-exists-p path))\n                              return (find-file-noselect path))\n                     (cl-loop for bf in cider-buffers\n                              if (string= (buffer-name bf) url)\n                              return bf))))))))\n\n(defun cider--open-other-window-p (arg)\n  \"Test prefix value ARG to see if it indicates displaying results in other window.\"\n  (let ((narg (prefix-numeric-value arg)))\n    (pcase narg\n      (-1 t) ; -\n      (16 t) ; empty empty\n      (_ nil))))\n\n(defun cider-abbreviate-ns (namespace)\n  \"Return a string that abbreviates NAMESPACE.\"\n  (when namespace\n    (let* ((names (reverse (split-string namespace \"\\\\.\")))\n           (lastname (car names)))\n      (concat (mapconcat (lambda (s) (concat (substring s 0 1) \".\"))\n                         (reverse (cdr names))\n                         \"\")\n              lastname))))\n\n(defun cider-last-ns-segment (namespace)\n  \"Return the last segment of NAMESPACE.\"\n  (when namespace\n    (car (reverse (split-string namespace \"\\\\.\")))))\n\n\n(provide 'cider-common)\n;;; cider-common.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-completion.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53454830,"end":53454873},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53454873},"to":{"change":3,"start":53442437,"end":53442437},"introduced_by":3}],"inode":{"change":3,"pos":53442437}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53442437},"to":{"change":3,"start":53442438,"end":53454829},"introduced_by":3}],"inode":{"change":3,"pos":53442437}},"content":[{"Del":";;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \n;;         Artur Malabarba \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Smart REPL-powered code completion and integration with company-mode.\n\n;;; Code:\n\n(require 'subr-x)\n(require 'thingatpt)\n\n(require 'cider-client)\n(require 'cider-common)\n(require 'cider-doc)\n(require 'cider-eldoc)\n(require 'nrepl-dict)\n\n(defcustom cider-completion-use-context t\n  \"When true, uses context at point to improve completion suggestions.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.7.0\"))\n\n(defcustom cider-annotate-completion-candidates t\n  \"When true, annotate completion candidates with some extra information.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.8.0\"))\n\n(defcustom cider-annotate-completion-function\n  #'cider-default-annotate-completion-function\n  \"Controls how the annotations for completion candidates are formatted.\nMust be a function that takes two arguments: the abbreviation of the\ncandidate type according to `cider-completion-annotations-alist' and the\ncandidate's namespace.\"\n  :type 'function\n  :group 'cider\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-completion-annotations-alist\n  '((\"class\" \"c\")\n    (\"field\" \"fi\")\n    (\"function\" \"f\")\n    (\"import\" \"i\")\n    (\"keyword\" \"k\")\n    (\"local\" \"l\")\n    (\"macro\" \"m\")\n    (\"method\" \"me\")\n    (\"namespace\" \"n\")\n    (\"protocol\" \"p\")\n    (\"protocol-function\" \"pf\")\n    (\"record\" \"r\")\n    (\"special-form\" \"s\")\n    (\"static-field\" \"sf\")\n    (\"static-method\" \"sm\")\n    (\"type\" \"t\")\n    (\"var\" \"v\"))\n  \"Controls the abbreviations used when annotating completion candidates.\n\nMust be a list of elements with the form (TYPE . ABBREVIATION), where TYPE\nis a possible value of the candidate's type returned from the completion\nbackend, and ABBREVIATION is a short form of that type.\"\n  :type '(alist :key-type string :value-type string)\n  :group 'cider\n  :package-version '(cider . \"0.9.0\"))\n\n(defconst cider-completion-kind-alist\n  '((\"class\" class)\n    (\"field\" field)\n    (\"function\" function)\n    (\"import\" class)\n    (\"keyword\" keyword)\n    (\"local\" variable)\n    (\"macro\" macro)\n    (\"method\" method)\n    (\"namespace\" module)\n    (\"protocol\" enum)\n    (\"protocol-function\" enum-member)\n    (\"record\" struct)\n    (\"special-form\" keyword)\n    (\"static-field\" field)\n    (\"static-method\" interface)\n    (\"type\" parameter)\n    (\"var\" variable))\n  \"Icon mapping for company-mode.\")\n\n(defcustom cider-completion-annotations-include-ns 'unqualified\n  \"Controls passing of namespaces to `cider-annotate-completion-function'.\n\nWhen set to 'always, the candidate's namespace will always be passed if it\nis available.  When set to 'unqualified, the namespace will only be passed\nif the candidate is not namespace-qualified.\"\n  :type '(choice (const always)\n                 (const unqualified)\n                 (const :tag \"never\" nil))\n  :group 'cider\n  :package-version '(cider . \"0.9.0\"))\n\n(defvar cider-completion-last-context nil)\n\n(defun cider-completion-symbol-start-pos ()\n  \"Find the starting position of the symbol at point, unless inside a string.\"\n  (let ((sap (symbol-at-point)))\n    (when (and sap (not (nth 3 (syntax-ppss))))\n      (car (bounds-of-thing-at-point 'symbol)))))\n\n(defun cider-completion-get-context-at-point ()\n  \"Extract the context at point.\nIf point is not inside the list, returns nil; otherwise return \\\"top-level\\\"\nform, with symbol at point replaced by __prefix__.\"\n  (when (save-excursion\n          (condition-case _\n              (progn\n                (up-list)\n                (check-parens)\n                t)\n            (scan-error nil)\n            (user-error nil)))\n    (save-excursion\n      (let* ((pref-end (point))\n             (pref-start (cider-completion-symbol-start-pos))\n             (context (cider-defun-at-point))\n             (_ (beginning-of-defun))\n             (expr-start (point)))\n        (concat (when pref-start (substring context 0 (- pref-start expr-start)))\n                \"__prefix__\"\n                (substring context (- pref-end expr-start)))))))\n\n(defun cider-completion-get-context ()\n  \"Extract context depending on `cider-completion-use-context' and major mode.\"\n  (let ((context (if (and cider-completion-use-context\n                          ;; Important because `beginning-of-defun' and\n                          ;; `ending-of-defun' work incorrectly in the REPL\n                          ;; buffer, so context extraction fails there.\n                          (derived-mode-p 'clojure-mode))\n                     ;; We use ignore-errors here since grabbing the context\n                     ;; might fail because of unbalanced parens, or other\n                     ;; technical reasons, yet we don't want to lose all\n                     ;; completions and throw error to user because of that.\n                     (or (ignore-errors (cider-completion-get-context-at-point))\n                         \"nil\")\n                   \"nil\")))\n    (if (string= cider-completion-last-context context)\n        \":same\"\n      (setq cider-completion-last-context context)\n      context)))\n\n(defun cider-completion--parse-candidate-map (candidate-map)\n  \"Get \\\"candidate\\\" from CANDIDATE-MAP.\nPut type and ns properties on the candidate\"\n  (let ((candidate (nrepl-dict-get candidate-map \"candidate\"))\n        (type (nrepl-dict-get candidate-map \"type\"))\n        (ns (nrepl-dict-get candidate-map \"ns\")))\n    (put-text-property 0 1 'type type candidate)\n    (put-text-property 0 1 'ns ns candidate)\n    candidate))\n\n(defun cider-complete (prefix)\n  \"Complete PREFIX with context at point.\nCompletion relies on nREPL middleware.  First\nwe check if cider-nrepl's complete op is available\nand afterward we fallback on nREPL's built-in\ncompletion functionality.\"\n  (cond\n   ;; if we don't have a connection, end early\n   ((not (cider-connected-p)) nil)\n   ;; next we try if cider-nrepl's completion is available\n   ((cider-nrepl-op-supported-p \"complete\")\n    (let* ((context (cider-completion-get-context))\n           (candidates (cider-sync-request:complete prefix context)))\n      (mapcar #'cider-completion--parse-candidate-map candidates)))\n   ;; then we fallback to nREPL's built-in op (available in nREPL 0.8+)\n   ((cider-nrepl-op-supported-p \"completions\")\n    (mapcar #'cider-completion--parse-candidate-map (cider-sync-request:completion prefix)))\n   (t nil)))\n\n(defun cider-completion--get-candidate-type (symbol)\n  \"Get candidate type for SYMBOL.\"\n  (let ((type (get-text-property 0 'type symbol)))\n    (or (cadr (assoc type cider-completion-annotations-alist))\n        type)))\n\n(defun cider-completion--get-candidate-ns (symbol)\n  \"Get candidate ns for SYMBOL.\"\n  (when (or (eq 'always cider-completion-annotations-include-ns)\n            (and (eq 'unqualified cider-completion-annotations-include-ns)\n                 (not (cider-namespace-qualified-p symbol))))\n    (get-text-property 0 'ns symbol)))\n\n(defun cider-default-annotate-completion-function (type ns)\n  \"Get completion function based on TYPE and NS.\"\n  (concat (when ns (format \" (%s)\" ns))\n          (when type (format \" <%s>\" type))))\n\n(defun cider-company-symbol-kind (symbol)\n  \"Get SYMBOL kind for company-mode.\"\n  (let ((type (get-text-property 0 'type symbol)))\n    (or (cadr (assoc type cider-completion-kind-alist))\n        type)))\n\n(defun cider-annotate-symbol (symbol)\n  \"Return a string suitable for annotating SYMBOL.\nIf SYMBOL has a text property `type` whose value is recognised, its\nabbreviation according to `cider-completion-annotations-alist' will be\nused.  If `type` is present but not recognised, its value will be used\nunaltered.  If SYMBOL has a text property `ns`, then its value will be used\naccording to `cider-completion-annotations-include-ns'.  The formatting is\nperformed by `cider-annotate-completion-function'.\"\n  (when cider-annotate-completion-candidates\n    (let* ((type (cider-completion--get-candidate-type symbol))\n           (ns (cider-completion--get-candidate-ns symbol)))\n      (funcall cider-annotate-completion-function type ns))))\n\n(defun cider-complete-at-point ()\n  \"Complete the symbol at point.\"\n  (when-let* ((bounds (bounds-of-thing-at-point 'symbol)))\n    (when (and (cider-connected-p)\n               (not (or (cider-in-string-p) (cider-in-comment-p))))\n      (list (car bounds) (cdr bounds)\n            (lambda (prefix pred action)\n              ;; When the 'action is 'metadata, this lambda returns metadata about this\n              ;; capf, when action is (boundaries . suffix), it returns nil. With every\n              ;; other value of 'action (t, nil, or lambda), 'action is forwarded to\n              ;; (complete-with-action), together with (cider-complete), prefix and pred.\n              ;; And that function performs the completion based on those arguments.\n              ;;\n              ;; This api is better described in the section\n              ;; '21.6.7 Programmed Completion' of the elisp manual.\n              (cond ((eq action 'metadata) `(metadata (category . cider)))\n                    ((eq (car-safe action) 'boundaries) nil)\n                    (t (with-current-buffer (current-buffer)\n                         (complete-with-action action\n                                               (cider-complete prefix) prefix pred)))))\n            :annotation-function #'cider-annotate-symbol\n            :company-kind #'cider-company-symbol-kind\n            :company-doc-buffer #'cider-create-doc-buffer\n            :company-location #'cider-company-location\n            :company-docsig #'cider-company-docsig))))\n\n(defun cider-completion-flush-caches ()\n  \"Force Compliment to refill its caches.\nThis command should be used if Compliment fails to pick up new classnames\nand methods from dependencies that were loaded dynamically after the REPL\nhas started.\"\n  (interactive)\n  (cider-sync-request:complete-flush-caches))\n\n(defun cider-company-location (var)\n  \"Open VAR's definition in a buffer.\nReturns the cons of the buffer itself and the location of VAR's definition\nin the buffer.\"\n  (when-let* ((info (cider-var-info var))\n              (file (nrepl-dict-get info \"file\"))\n              (line (nrepl-dict-get info \"line\"))\n              (buffer (cider-find-file file)))\n    (with-current-buffer buffer\n      (save-excursion\n        (goto-char (point-min))\n        (forward-line (1- line))\n        (cons buffer (point))))))\n\n(defun cider-company-docsig (thing)\n  \"Return signature for THING.\"\n  (let* ((eldoc-info (cider-eldoc-info thing))\n         (ns (lax-plist-get eldoc-info \"ns\"))\n         (symbol (lax-plist-get eldoc-info \"symbol\"))\n         (arglists (lax-plist-get eldoc-info \"arglists\")))\n    (when eldoc-info\n      (format \"%s: %s\"\n              (cider-eldoc-format-thing ns symbol thing\n                                        (cider-eldoc-thing-type eldoc-info))\n              (cider-eldoc-format-arglist arglists 0)))))\n\n;; Fuzzy completion for company-mode\n\n(defun cider-company-unfiltered-candidates (string &rest _)\n  \"Return CIDER completion candidates for STRING as is, unfiltered.\"\n  (cider-complete string))\n\n(add-to-list 'completion-styles-alist\n             '(cider\n               cider-company-unfiltered-candidates\n               cider-company-unfiltered-candidates\n               \"CIDER backend-driven completion style.\"))\n\n(defun cider-company-enable-fuzzy-completion ()\n  \"Enable backend-driven fuzzy completion in the current buffer.\"\n  (setq-local completion-styles '(cider)))\n\n(provide 'cider-completion)\n;;; cider-completion.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-connection.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53442392,"end":53442435},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53442435},"to":{"change":3,"start":53397867,"end":53397867},"introduced_by":3}],"inode":{"change":3,"pos":53397867}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53397867},"to":{"change":3,"start":53397868,"end":53442391},"introduced_by":3}],"inode":{"change":3,"pos":53397867}},"content":[{"Del":";;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*-\n;;\n;; Copyright © 2019-2022 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors\n;;\n;; Author: Artur Malabarba \n;;         Bozhidar Batsov \n;;         Vitalie Spinu \n;;\n;; Keywords: languages, clojure, cider\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;; This file is not part of GNU Emacs.\n;;\n;;\n;;; Commentary:\n;;\n;;\n;;; Code:\n\n(require 'nrepl-client)\n(require 'cl-lib)\n(require 'format-spec)\n(require 'sesman)\n(require 'sesman-browser)\n(require 'spinner)\n(require 'cider-popup)\n(require 'cider-util)\n\n(defcustom cider-session-name-template \"%J:%h:%p\"\n  \"Format string to use for session names.\nSee `cider-format-connection-params' for available format characters.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.18.0\"))\n\n(defcustom cider-redirect-server-output-to-repl  t\n  \"Controls whether nREPL server output would be redirected to the REPL.\nWhen non-nil the output would end up in both the nrepl-server buffer (when\navailable) and the matching REPL buffer.\"\n  :type 'boolean\n  :group 'cider\n  :safe #'booleanp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-auto-mode t\n  \"When non-nil, automatically enable cider mode for all Clojure buffers.\"\n  :type 'boolean\n  :group 'cider\n  :safe #'booleanp\n  :package-version '(cider . \"0.9.0\"))\n\n;;;###autoload\n(defcustom cider-merge-sessions nil\n  \"Controls session combination behaviour.\n\nSymbol `host' combines all sessions of a project associated with the same host.\nSymbol `project' combines all sessions of a project.\n\nAll other values do not combine any sessions.\"\n  :type 'symbol\n  :group 'cider\n  :safe #'symbolp\n  :package-version '(cider . \"1.5\"))\n\n(defconst cider-required-nrepl-version \"0.6.0\"\n  \"The minimum nREPL version that's known to work properly with CIDER.\")\n\n\f\n;;; Connect\n\n(defun cider-nrepl-connect (params)\n  \"Start nrepl client and create the REPL.\nPARAMS is a plist containing :host, :port, :server and other parameters for\n`cider-repl-create'.\"\n  (process-buffer\n   (nrepl-start-client-process\n    (plist-get params :host)\n    (plist-get params :port)\n    (plist-get params :server)\n    (lambda (_)\n      (cider-repl-create params))\n    (plist-get params :socket-file))))\n\n(defun cider-sessions ()\n  \"Return a list of all active CIDER sessions.\"\n  (sesman-sessions 'CIDER))\n\n(defun cider-connected-p ()\n  \"Return t if CIDER is currently connected, nil otherwise.\"\n  (process-live-p (get-buffer-process (cider-current-repl))))\n\n(defun cider-ensure-connected ()\n  \"Ensure there is a linked CIDER session.\"\n  (sesman-ensure-session 'CIDER))\n\n(defun cider--session-server (session)\n  \"Return server buffer for SESSION or nil if there is no server.\"\n  (seq-some (lambda (r)\n              (buffer-local-value 'nrepl-server-buffer r))\n            (cdr session)))\n\n(defun cider--gather-session-params (session)\n  \"Gather all params for a SESSION.\"\n  (let (params)\n    (dolist (repl (cdr session))\n      (setq params (cider--gather-connect-params params repl)))\n    (when-let* ((server (cider--session-server session)))\n      (setq params (cider--gather-connect-params params server)))\n    params))\n\n(defun cider--gather-connect-params (&optional params proc-buffer)\n  \"Gather all relevant connection parameters into PARAMS plist.\nPROC-BUFFER is either server or client buffer, defaults to current buffer.\"\n  (let ((proc-buffer (or proc-buffer (current-buffer))))\n    (with-current-buffer proc-buffer\n      (unless nrepl-endpoint\n        (error \"This is not a REPL or SERVER buffer; is there an active REPL?\"))\n      (let ((server-buf (if (nrepl-server-p proc-buffer)\n                            proc-buffer\n                          nrepl-server-buffer)))\n        (cl-loop for l on nrepl-endpoint by #'cddr\n                 do (setq params (plist-put params (car l) (cadr l))))\n        (setq params (thread-first\n                       params\n                       (plist-put :project-dir nrepl-project-dir)))\n        (when (buffer-live-p server-buf)\n          (setq params (thread-first\n                         params\n                         (plist-put :server (get-buffer-process server-buf))\n                         (plist-put :server-command nrepl-server-command))))\n        ;; repl-specific parameters (do not pollute server params!)\n        (unless (nrepl-server-p proc-buffer)\n          (setq params (thread-first\n                         params\n                         (plist-put :session-name cider-session-name)\n                         (plist-put :repl-type cider-repl-type)\n                         (plist-put :cljs-repl-type cider-cljs-repl-type)\n                         (plist-put :repl-init-function cider-repl-init-function))))\n        params))))\n\n(defun cider--close-buffer (buffer)\n  \"Close the BUFFER and kill its associated process (if any).\"\n  (when (buffer-live-p buffer)\n    (when-let* ((proc (get-buffer-process buffer)))\n      (when (process-live-p proc)\n        (delete-process proc)))\n    (kill-buffer buffer)))\n\n(declare-function cider-repl-emit-interactive-stderr \"cider-repl\")\n(defun cider--close-connection (repl &optional no-kill)\n  \"Close connection associated with REPL.\nWhen NO-KILL is non-nil stop the connection but don't kill the REPL\nbuffer.\"\n  (when (buffer-live-p repl)\n    (with-current-buffer repl\n      (when spinner-current (spinner-stop))\n      (when nrepl-tunnel-buffer\n        (cider--close-buffer nrepl-tunnel-buffer))\n      (when no-kill\n        ;; inform sentinel not to kill the server, if any\n        (thread-first\n          (get-buffer-process repl)\n          (process-plist)\n          (plist-put :keep-server t))))\n    (let ((proc (get-buffer-process repl)))\n      (when (and (process-live-p proc)\n                 (or (not nrepl-server-buffer)\n                     ;; Sync request will hang if the server is dead.\n                     (process-live-p (get-buffer-process nrepl-server-buffer))))\n        (nrepl-sync-request:close repl)\n        (delete-process proc)))\n    (when-let* ((messages-buffer (and nrepl-log-messages\n                                      (nrepl-messages-buffer repl))))\n      (kill-buffer messages-buffer))\n    (unless no-kill\n      (kill-buffer repl)))\n  (when repl\n    (sesman-remove-object 'CIDER nil repl (not no-kill) t)))\n\n(defun cider-emit-manual-warning (section-id format &rest args)\n  \"Emit a warning to the REPL and link to the online manual.\nSECTION-ID is the section to link to.  The link is added on the last line.\nFORMAT is a format string to compile with ARGS and display on the REPL.\"\n  (let ((message (apply #'format format args)))\n    (cider-repl-emit-interactive-stderr\n     (concat \"WARNING: \" message \" (\"\n             (cider--manual-button \"More information\" section-id)\n             \")\\n\"))))\n\n(defvar cider-version)\n(defun cider--check-required-nrepl-version ()\n  \"Check whether we're using a compatible nREPL version.\"\n  (if-let* ((nrepl-version (cider--nrepl-version)))\n      (when (version< nrepl-version cider-required-nrepl-version)\n        (cider-emit-manual-warning \"troubleshooting.html#warning-saying-you-have-to-use-newer-nrepl\"\n                                   \"CIDER requires nREPL %s (or newer) to work properly\"\n                                   cider-required-nrepl-version))))\n\n(defvar cider-minimum-clojure-version)\n(defun cider--check-clojure-version-supported ()\n  \"Ensure that we are meeting the minimum supported version of Clojure.\"\n  (if-let* ((clojure-version (cider--clojure-version))\n            ;; drop all qualifiers from the version string\n            ;; e.g. 1.10.0-master-SNAPSHOT becomes simply 1.10.0\n            (clojure-version (car (split-string clojure-version \"-\"))))\n      (when (version< clojure-version cider-minimum-clojure-version)\n        (cider-emit-manual-warning \"basics/installation.html#prerequisites\"\n                                   \"Clojure version (%s) is not supported (minimum %s). CIDER will not work.\"\n                                   clojure-version cider-minimum-clojure-version))))\n\n(defun cider--strip-version-patch (v)\n  \"Strips everything but major.minor from the version, returning a version list.\nV is the version string to strip the patch from.\"\n  (seq-take (version-to-list v) 2))\n\n(defun cider--compatible-middleware-version-p (required-ver ver)\n  \"Checks that the available middleware version is compatible with the required.\nWe look only at the major and minor components.  When the major\nversion is 0, only check that the minor versions match.  When the major version\nis > 0, first check that the major version matches, then that the minor\nversion is >= the required minor version.\nVER the 'installed' version,\nREQUIRED-VER the version required by cider.\"\n  (let ((ver* (cider--strip-version-patch ver))\n        (required-ver* (cider--strip-version-patch required-ver)))\n    (cond ((= 0 (car required-ver*))  (= (cadr required-ver*)\n                                         (cadr ver*)))\n          (t (and (= (car required-ver*)\n                     (car ver*))\n                  (version-list-<= required-ver* ver*))))))\n\n(defvar cider-required-middleware-version)\n(defun cider--check-middleware-compatibility ()\n  \"CIDER frontend/backend compatibility check.\nRetrieve the underlying connection's CIDER-nREPL version and checks if the\nmiddleware used is compatible with CIDER.  If not, will display a warning\nmessage in the REPL area.\"\n  (let* ((version-dict        (nrepl-aux-info \"cider-version\" (cider-current-repl)))\n         (middleware-version  (nrepl-dict-get version-dict \"version-string\")))\n    (cond\n     ((null middleware-version)\n      (cider-emit-manual-warning \"troubleshooting.html#cider-complains-of-the-cider-nrepl-version\"\n                                 \"CIDER requires cider-nrepl to be fully functional. Some features will not be available without it!\"))\n     ((not (cider--compatible-middleware-version-p cider-required-middleware-version middleware-version))\n      (cider-emit-manual-warning \"troubleshooting.html#cider-complains-of-the-cider-nrepl-version\"\n                                 \"CIDER %s requires cider-nrepl %s, but you're currently using cider-nrepl %s. The version mismatch might break some functionality!\"\n                                 cider-version cider-required-middleware-version middleware-version)))))\n\n(declare-function cider-interactive-eval-handler \"cider-eval\")\n(declare-function cider-nrepl-send-request \"cider-client\")\n;; TODO: Use some null handler here\n(defun cider--subscribe-repl-to-server-out ()\n  \"Subscribe to the nREPL server's *out*.\"\n  (cider-nrepl-send-request '(\"op\" \"out-subscribe\")\n                            (cider-interactive-eval-handler (current-buffer))))\n\n(declare-function cider-mode \"cider-mode\")\n(defun cider-enable-on-existing-clojure-buffers ()\n  \"Enable CIDER's minor mode on existing Clojure buffers.\nSee command `cider-mode'.\"\n  (interactive)\n  (add-hook 'clojure-mode-hook #'cider-mode)\n  (dolist (buffer (cider-util--clojure-buffers))\n    (with-current-buffer buffer\n      (cider-mode +1)\n      ;; In global-eldoc-mode, a new file-visiting buffer calls\n      ;; `turn-on-eldoc-mode' which enables eldoc-mode if it's supported in that\n      ;; buffer as determined by `eldoc--supported-p'.  Cider's eldoc support\n      ;; allows new buffers in cider-mode to enable eldoc-mode.  As of 2021-04,\n      ;; however, clojure-mode itself has no eldoc support, so old clojure\n      ;; buffers opened before cider started aren't necessarily in eldoc-mode.\n      ;; Here, we've enabled cider-mode for this old clojure buffer, and now, if\n      ;; global-eldoc-mode is enabled, try to enable eldoc-mode as if the buffer\n      ;; had just been created with cider-mode.\n      (when global-eldoc-mode\n        (turn-on-eldoc-mode)))))\n\n(declare-function cider--debug-mode \"cider-debug\")\n(defun cider-disable-on-existing-clojure-buffers ()\n  \"Disable `cider-mode' and related commands on existing Clojure buffers.\"\n  (interactive)\n  (dolist (buffer (cider-util--clojure-buffers))\n    (with-current-buffer buffer\n      (cider--debug-mode -1)\n      (cider-mode -1))))\n\n(defun cider-possibly-disable-on-existing-clojure-buffers ()\n  \"Disable `cider-mode' in all Clojure buffers if all CIDER sessions are closed.\"\n  (unless (cider-sessions)\n    (cider-disable-on-existing-clojure-buffers)))\n\n(declare-function cider--debug-init-connection \"cider-debug\")\n(declare-function cider-repl-init \"cider-repl\")\n(declare-function cider-nrepl-op-supported-p \"cider-client\")\n(defun cider--connected-handler ()\n  \"Handle CIDER initialization after nREPL connection has been established.\nThis function is appended to `nrepl-connected-hook' in the client process\nbuffer.\"\n  ;; `nrepl-connected-hook' is run in the connection buffer\n  ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit\n  ;; it here as the debugger isn't necessarily initialized yet\n  (let ((cider-enlighten-mode nil))\n    ;; after initialization, set mode-line and buffer name.\n    (cider-set-repl-type cider-repl-type)\n    (cider-repl-init\n     (current-buffer)\n     (lambda ()\n       ;; Init logic that's specific to Clojure's nREPL and cider-nrepl\n       (when (cider-runtime-clojure-p)\n         (cider--check-required-nrepl-version)\n         (cider--check-clojure-version-supported)\n         (cider--check-middleware-compatibility)\n\n         ;; Redirect the nREPL's terminal output to a REPL buffer.\n         ;; If we don't do this the server's output will end up\n         ;; in the *nrepl-server* buffer.\n         (when (and cider-redirect-server-output-to-repl\n                    (cider-nrepl-op-supported-p \"out-subscribe\"))\n           (cider--subscribe-repl-to-server-out))\n\n         ;; Middleware on cider-nrepl's side is deferred until first usage, but\n         ;; loading middleware concurrently can lead to occasional \"require\" issues\n         ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards\n         ;; the end, allowing for the faster \"server-out\" middleware to load\n         ;; first.\n         (cider--debug-init-connection))\n\n       (when cider-repl-init-function\n         (funcall cider-repl-init-function))\n\n       (when cider-auto-mode\n         (cider-enable-on-existing-clojure-buffers))\n\n       (run-hooks 'cider-connected-hook)))))\n\n(defun cider--disconnected-handler ()\n  \"Cleanup after nREPL connection has been lost or closed.\nThis function is appended to `nrepl-disconnected-hook' in the client\nprocess buffer.\"\n  ;; `nrepl-connected-hook' is run in the connection buffer\n  (cider-possibly-disable-on-existing-clojure-buffers)\n  (run-hooks 'cider-disconnected-hook))\n\n\f\n;;; Connection Info\n\n(defun cider--java-version ()\n  \"Retrieve the underlying connection's Java version.\"\n  (with-current-buffer (cider-current-repl)\n    (when nrepl-versions\n      (thread-first\n        nrepl-versions\n        (nrepl-dict-get \"java\")\n        (nrepl-dict-get \"version-string\")))))\n\n(defun cider--clojure-version ()\n  \"Retrieve the underlying connection's Clojure version.\"\n  (with-current-buffer (cider-current-repl)\n    (when nrepl-versions\n      (thread-first\n        nrepl-versions\n        (nrepl-dict-get \"clojure\")\n        (nrepl-dict-get \"version-string\")))))\n\n(defun cider--nrepl-version ()\n  \"Retrieve the underlying connection's nREPL version.\"\n  (with-current-buffer (cider-current-repl)\n    (when nrepl-versions\n      (thread-first\n        nrepl-versions\n        (nrepl-dict-get \"nrepl\")\n        (nrepl-dict-get \"version-string\")))))\n\n(defun cider--babashka-version ()\n  \"Retrieve the underlying connection's Babashka version.\"\n  (with-current-buffer (cider-current-repl)\n    (when nrepl-versions\n      (nrepl-dict-get nrepl-versions \"babashka\"))))\n\n(defun cider--babashka-nrepl-version ()\n  \"Retrieve the underlying connection's babashka.nrepl version.\"\n  (with-current-buffer (cider-current-repl)\n    (when nrepl-versions\n      (nrepl-dict-get nrepl-versions \"babashka.nrepl\"))))\n\n(defun cider-runtime ()\n  \"Return the runtime of the nREPl server.\"\n  (cond\n   ((cider--clojure-version) 'clojure)\n   ((cider--babashka-version) 'babashka)\n   (t 'generic)))\n\n(defun cider-runtime-clojure-p ()\n  \"Check if the current runtime is Clojure.\"\n  (eq (cider-runtime) 'clojure))\n\n(defun cider--connection-info (connection-buffer &optional genericp)\n  \"Return info about CONNECTION-BUFFER.\nInfo contains project name, current REPL namespace, host:port endpoint and\nruntime details.  When GENERICP is non-nil, don't provide specific info\nabout this buffer (like variable `cider-repl-type').\"\n  (with-current-buffer connection-buffer\n    (cond\n     ((cider--clojure-version)\n      (format \"%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)\"\n              (if genericp \"\" (upcase (concat (symbol-name cider-repl-type) \" \")))\n              (or (cider--project-name nrepl-project-dir) \"\")\n              (plist-get nrepl-endpoint :host)\n              (plist-get nrepl-endpoint :port)\n              (cider--java-version)\n              (cider--clojure-version)\n              (cider--nrepl-version)))\n     ((cider--babashka-version)\n      (format \"%s%s@%s:%s (Babashka %s, babashka.nrepl %s)\"\n              (if genericp \"\" (upcase (concat (symbol-name cider-repl-type) \" \")))\n              (or (cider--project-name nrepl-project-dir) \"\")\n              (plist-get nrepl-endpoint :host)\n              (plist-get nrepl-endpoint :port)\n              (cider--babashka-version)\n              (cider--babashka-nrepl-version)))\n     (t\n      (format \"%s%s@%s:%s\"\n              (if genericp \"\" (upcase (concat (symbol-name cider-repl-type) \" \")))\n              (or (cider--project-name nrepl-project-dir) \"\")\n              (plist-get nrepl-endpoint :host)\n              (plist-get nrepl-endpoint :port))))))\n\n\f\n;;; Connection Management Commands\n\n(defun cider-quit (&optional repl)\n  \"Quit the CIDER connection associated with REPL.\nREPL defaults to the current REPL.\"\n  (interactive)\n  (let ((repl (or repl\n                  (sesman-browser-get 'object)\n                  (cider-current-repl nil 'ensure))))\n    (cider--close-connection repl))\n  ;; if there are no more sessions we can kill all ancillary buffers\n  (unless (cider-sessions)\n    (cider-close-ancillary-buffers))\n  ;; need this to refresh sesman browser\n  (run-hooks 'sesman-post-command-hook))\n\n(defun cider-restart (&optional repl)\n  \"Restart CIDER connection associated with REPL.\nREPL defaults to the current REPL.  Don't restart the server or other\nconnections within the same session.  Use `sesman-restart' to restart the\nentire session.\"\n  (interactive)\n  (let* ((repl (or repl\n                   (sesman-browser-get 'object)\n                   (cider-current-repl nil 'ensure)))\n         (params (thread-first\n                   ()\n                   (cider--gather-connect-params repl)\n                   (plist-put :session-name (sesman-session-name-for-object 'CIDER repl))\n                   (plist-put :repl-buffer repl))))\n    (cider--close-connection repl 'no-kill)\n    (cider-nrepl-connect params)\n    ;; need this to refresh sesman browser\n    (run-hooks 'sesman-post-command-hook)))\n\n(defun cider-close-ancillary-buffers ()\n  \"Close buffers that are shared across connections.\"\n  (interactive)\n  (dolist (buf-name cider-ancillary-buffers)\n    (when (get-buffer buf-name)\n      (kill-buffer buf-name))))\n\n(defun cider-describe-connection (&optional repl)\n  \"Display information about the connection associated with REPL.\nREPL defaults to the current REPL.\"\n  (interactive)\n  (let ((repl (or repl\n                  (sesman-browser-get 'object)\n                  (cider-current-repl nil 'ensure))))\n    (message \"%s\" (cider--connection-info repl))))\n\n(defconst cider-nrepl-session-buffer \"*cider-nrepl-session*\")\n\n(declare-function cider-nrepl-eval-session \"cider-client\")\n(declare-function cider-nrepl-tooling-session \"cider-client\")\n(defun cider-describe-nrepl-session ()\n  \"Describe an nREPL session.\"\n  (interactive)\n  (cider-ensure-connected)\n  (let* ((repl (cider-current-repl nil 'ensure))\n         (selected-session (completing-read \"Describe nREPL session: \" (nrepl-sessions repl))))\n    (when (and selected-session (not (equal selected-session \"\")))\n      (let* ((session-info (nrepl-sync-request:describe repl))\n             (ops (nrepl-dict-keys (nrepl-dict-get session-info \"ops\")))\n             (session-id (nrepl-dict-get session-info \"session\"))\n             (session-type (cond\n                            ((equal session-id (cider-nrepl-eval-session)) \"Active eval\")\n                            ((equal session-id (cider-nrepl-tooling-session)) \"Active tooling\")\n                            (t \"Unknown\"))))\n        (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary)\n          (read-only-mode -1)\n          (insert (format \"Session: %s\\n\" session-id)\n                  (format \"Type: %s session\\n\" session-type)\n                  (format \"Supported ops:\\n\"))\n          (mapc (lambda (op) (insert (format \"  * %s\\n\" op))) ops)))\n      (display-buffer cider-nrepl-session-buffer))))\n\n(defun cider-list-nrepl-middleware ()\n  \"List the loaded nREPL middleware.\"\n  (interactive)\n  (cider-ensure-connected)\n  (let* ((repl (cider-current-repl nil 'ensure))\n         (middleware (nrepl-middleware repl)))\n    (with-current-buffer (cider-popup-buffer \"*cider-nrepl-middleware*\" 'select nil 'ancillary)\n      (read-only-mode -1)\n      (insert (format \"Currently loaded middleware:\\n\"))\n      (mapc (lambda (mw) (insert (format \"  * %s\\n\" mw))) middleware))\n    (display-buffer \"*cider-nrepl-middleware*\")))\n\n\f\n;;; Sesman's Session-Wise Management UI\n\n(cl-defmethod sesman-project ((_system (eql CIDER)))\n  \"Find project directory.\"\n  (clojure-project-dir (cider-current-dir)))\n\n(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2)\n  \"Figure out if SESSION1 or SESSION2 is more relevant.\"\n  (sesman-more-recent-p (cdr session1) (cdr session2)))\n\n(declare-function cider-classpath-entries \"cider-client\")\n(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session)\n  \"Check if SESSION is a friendly session.\"\n  (setcdr session (seq-filter #'buffer-live-p (cdr session)))\n  (when-let* ((repl (cadr session))\n              (proc (get-buffer-process repl))\n              (file (file-truename (or (buffer-file-name) default-directory))))\n    ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj\n    (when (string-match-p \"#uzip\" file)\n      (let ((avfs-path (directory-file-name (expand-file-name (or (getenv \"AVFSBASE\")  \"~/.avfs/\")))))\n        (setq file (replace-regexp-in-string avfs-path \"\" file t t))))\n    (when (process-live-p proc)\n      (let* ((classpath (or (process-get proc :cached-classpath)\n                            (let ((cp (with-current-buffer repl\n                                        (cider-classpath-entries))))\n                              (process-put proc :cached-classpath cp)\n                              cp)))\n             (classpath-roots (or (process-get proc :cached-classpath-roots)\n                                  (let ((cp (thread-last\n                                              classpath\n                                              (seq-filter (lambda (path) (not (string-match-p \"\\\\.jar$\" path))))\n                                              (mapcar #'file-name-directory)\n                                              (seq-remove  #'null)\n                                              (seq-uniq))))\n                                    (process-put proc :cached-classpath-roots cp)\n                                    cp))))\n        (or (seq-find (lambda (path) (string-prefix-p path file))\n                      classpath)\n            (seq-find (lambda (path) (string-prefix-p path file))\n                      classpath-roots))))))\n\n(defvar cider-sesman-browser-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"j q\") #'cider-quit)\n    (define-key map (kbd \"j k\") #'cider-quit)\n    (define-key map (kbd \"j r\") #'cider-restart)\n    (define-key map (kbd \"j d\") #'cider-describe-connection)\n    (define-key map (kbd \"j i\") #'cider-describe-connection)\n    (define-key map (kbd \"C-c C-q\") #'cider-quit)\n    (define-key map (kbd \"C-c C-q\") #'cider-quit)\n    (define-key map (kbd \"C-c C-r\") #'cider-restart)\n    (define-key map (kbd \"C-c M-r\") #'cider-restart)\n    (define-key map (kbd \"C-c C-d\") #'cider-describe-connection)\n    (define-key map (kbd \"C-c M-d\") #'cider-describe-connection)\n    (define-key map (kbd \"C-c C-i\") #'cider-describe-connection)\n    map)\n  \"Map active on REPL objects in sesman browser.\")\n\n(cl-defmethod sesman-session-info ((_system (eql CIDER)) session)\n  \"Obtain info for a CIDER SESSION.\"\n  (list :objects (cdr session)\n        :map cider-sesman-browser-map))\n\n(declare-function cider \"cider\")\n(cl-defmethod sesman-start-session ((_system (eql CIDER)))\n  \"Start a connection of any type interactively.\nFallback on `cider' command.\"\n  (call-interactively #'cider))\n\n(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session)\n  \"Quit a CIDER SESSION.\"\n  (mapc #'cider--close-connection (cdr session))\n  ;; if there are no more session we can kill all ancillary buffers\n  (unless (cider-sessions)\n    (cider-close-ancillary-buffers)))\n\n(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session)\n  \"Restart a CIDER SESSION.\"\n  (let* ((ses-name (car session))\n         (repls (cdr session))\n         (srv-buf (cider--session-server session)))\n    (if srv-buf\n        ;; session with a server\n        (let ((s-params (cider--gather-connect-params nil srv-buf)))\n          ;; 1) kill all connections, but keep the buffers\n          (mapc (lambda (conn)\n                  (cider--close-connection conn 'no-kill))\n                repls)\n          ;; 2) kill the server\n          (nrepl-kill-server-buffer srv-buf)\n          ;; 3) start server\n          (nrepl-start-server-process\n           (plist-get s-params :project-dir)\n           (plist-get s-params :server-command)\n           (lambda (server-buf)\n             ;; 4) restart the repls reusing the buffer\n             (dolist (r repls)\n               (cider-nrepl-connect\n                (thread-first\n                  ()\n                  (cider--gather-connect-params r)\n                  ;; server params (:port, :project-dir etc) have precedence\n                  (cider--gather-connect-params server-buf)\n                  (plist-put :session-name ses-name)\n                  (plist-put :repl-buffer r))))\n             (sesman-browser-revert-all 'CIDER)\n             (message \"Restarted CIDER %s session\" ses-name))))\n      ;; server-less session\n      (dolist (r repls)\n        (cider--close-connection r 'no-kill)\n        (cider-nrepl-connect\n         (thread-first\n           ()\n           (cider--gather-connect-params r)\n           (plist-put :session-name ses-name)\n           (plist-put :repl-buffer r)))))))\n\n(defun cider-format-connection-params (template params)\n  \"Format PARAMS with TEMPLATE string.\nThe following formats can be used in TEMPLATE string:\n\n  %h - host\n  %H - remote host, empty for local hosts\n  %p - port\n  %j - short project name, or directory name if no project\n  %J - long project name including parent dir name\n  %r - REPL type (clj or cljs)\n  %S - type of the ClojureScript runtime (Browser, Node, Figwheel etc.)\n  %s - session name as defined by `cider-session-name-template'.\n\nIn case some values are empty, extra separators (: and -) are automatically\nremoved.\"\n  (let* ((dir (directory-file-name\n               (abbreviate-file-name\n                (or (plist-get params :project-dir)\n                    (clojure-project-dir (cider-current-dir))\n                    default-directory))))\n         (short-proj (file-name-nondirectory (directory-file-name dir)))\n         (parent-dir (ignore-errors\n                       (thread-first dir file-name-directory\n                                     directory-file-name file-name-nondirectory\n                                     file-name-as-directory)))\n         (long-proj (format \"%s%s\" (or parent-dir \"\") short-proj))\n         ;; use `dir` if it is shorter than `long-proj` or `short-proj`\n         (short-proj (if (>= (length short-proj) (length dir))\n                         dir\n                       short-proj))\n         (long-proj (if (>= (length long-proj) (length dir))\n                        dir\n                      long-proj))\n         (port (or (plist-get params :port) \"\"))\n         (host (or (plist-get params :host) \"localhost\"))\n         (remote-host (if (member host '(\"localhost\" \"127.0.0.1\"))\n                          \"\"\n                        host))\n         (repl-type (or (plist-get params :repl-type) \"unknown\"))\n         (cljs-repl-type (or (and (eq repl-type 'cljs)\n                                  (plist-get params :cljs-repl-type))\n                             \"\"))\n         (specs `((?h . ,host)\n                  (?H . ,remote-host)\n                  (?p . ,port)\n                  (?j . ,short-proj)\n                  (?J . ,long-proj)\n                  (?r . ,repl-type)\n                  (?S . ,cljs-repl-type)))\n         (ses-name (or (plist-get params :session-name)\n                       (format-spec cider-session-name-template specs)))\n         (specs (append `((?s . ,ses-name)) specs)))\n    (thread-last\n      (format-spec template specs)\n      ;; remove extraneous separators\n      (replace-regexp-in-string \"\\\\([:-]\\\\)[:-]+\" \"\\\\1\")\n      (replace-regexp-in-string \"\\\\(^[:-]\\\\)\\\\|\\\\([:-]$\\\\)\" \"\")\n      (replace-regexp-in-string \"[:-]\\\\([])*]\\\\)\" \"\\\\1\"))))\n\n(defun cider-make-session-name (params)\n  \"Create new session name given plist of connection PARAMS.\nSession name can be customized with `cider-session-name-template'.\"\n  (let* ((root-name (cider-format-connection-params cider-session-name-template params))\n         (other-names (mapcar #'car (sesman-sessions 'CIDER)))\n         (name root-name)\n         (i 2))\n    (while (member name other-names)\n      (setq name (concat root-name \"#\" (number-to-string i))\n            i (+ i 1)))\n    name))\n\n\f\n;;; REPL Buffer Init\n\n(defvar-local cider-cljs-repl-type nil\n  \"The type of the ClojureScript runtime (Browser, Node, Figwheel, etc.).\")\n\n(defvar-local cider-repl-type nil\n  \"The type of this REPL buffer, usually either clj or cljs.\")\n\n(defun cider-repl-type (repl-buffer)\n  \"Get REPL-BUFFER's type.\"\n  (buffer-local-value 'cider-repl-type repl-buffer))\n\n(defun cider-repl-type-for-buffer (&optional buffer)\n  \"Return the matching connection type (clj or cljs) for BUFFER.\nBUFFER defaults to the `current-buffer'.  In cljc buffers return\nmulti.  This function infers connection type based on the major mode.\nFor the REPL type use the function `cider-repl-type'.\"\n  (with-current-buffer (or buffer (current-buffer))\n    (cond\n     ((derived-mode-p 'clojurescript-mode) 'cljs)\n     ((derived-mode-p 'clojurec-mode) 'multi)\n     ((derived-mode-p 'clojure-mode) 'clj)\n     (cider-repl-type))))\n\n(defun cider-set-repl-type (&optional type)\n  \"Set REPL TYPE to clj or cljs.\nAssume that the current buffer is a REPL.\"\n  (interactive)\n  (let ((type (cider-maybe-intern (or type (completing-read\n                                            (format \"Set REPL type (currently `%s') to: \"\n                                                    cider-repl-type)\n                                            '(clj cljs))))))\n    (when (or (not (equal cider-repl-type type))\n              (null mode-name))\n      (setq cider-repl-type type)\n      (setq mode-name (format \"REPL[%s]\" type))\n      (let ((params (cider--gather-connect-params)))\n        ;; We need to set current name to something else temporarily to avoid\n        ;; false name duplication in `nrepl-repl-buffer-name`.\n        (rename-buffer (generate-new-buffer-name \"*dummy-cider-repl-buffer*\"))\n        (rename-buffer (nrepl-repl-buffer-name params))\n        (when (and nrepl-log-messages nrepl-messages-buffer)\n          (with-current-buffer nrepl-messages-buffer\n            (rename-buffer (nrepl-messages-buffer-name params))))))))\n\n(defun cider--choose-reusable-repl-buffer (params)\n  \"Find connection-less REPL buffer and ask the user for confirmation.\nReturn nil if no such buffers exists or the user has chosen not to reuse\nthe buffer.  If multiple dead REPLs exist, ask the user to choose one.\nPARAMS is a plist as received by `cider-repl-create'.\"\n  (when-let* ((repls (seq-filter (lambda (b)\n                                   (with-current-buffer b\n                                     (and (derived-mode-p 'cider-repl-mode)\n                                          (not (process-live-p (get-buffer-process b))))))\n                                 (buffer-list))))\n    (let* ((proj-dir (plist-get params :project-dir))\n           (host (plist-get params :host))\n           (port (plist-get params :port))\n           (cljsp (member (plist-get params :repl-type) '(cljs pending-cljs)))\n           (scored-repls\n            (delq nil\n                  (mapcar (lambda (b)\n                            (let ((bparams (cider--gather-connect-params nil b)))\n                              (when (eq cljsp (member (plist-get bparams :repl-type)\n                                                      '(cljs pending-cljs)))\n                                (cons (buffer-name b)\n                                      (+\n                                       (if (equal proj-dir (plist-get bparams :project-dir)) 8 0)\n                                       (if (equal host (plist-get bparams :host)) 4 0)\n                                       (if (equal port (plist-get bparams :port)) 2 0))))))\n                          repls))))\n      (when scored-repls\n        (if (> (length scored-repls) 1)\n            (when (y-or-n-p \"Dead REPLs exist.  Reuse? \")\n              (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls)))\n                (get-buffer (completing-read \"REPL to reuse: \"\n                                             (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls)))))\n          (when (y-or-n-p (format \"A dead REPL %s exists.  Reuse? \" (caar scored-repls)))\n            (get-buffer (caar scored-repls))))))))\n\n(declare-function cider-default-err-handler \"cider-eval\")\n(declare-function cider-repl-mode \"cider-repl\")\n(declare-function cider-repl--state-handler \"cider-repl\")\n(declare-function cider-repl-reset-markers \"cider-repl\")\n(defvar-local cider-session-name nil)\n(defvar-local cider-repl-init-function nil)\n(defvar-local cider-launch-params nil)\n(defun cider-repl-create (params)\n  \"Create new repl buffer.\nPARAMS is a plist which contains :repl-type, :host, :port, :project-dir,\n:repl-init-function and :session-name.  When non-nil, :repl-init-function\nmust be a function with no arguments which is called after repl creation\nfunction with the repl buffer set as current.\"\n  ;; Connection might not have been set as yet. Please don't send requests in\n  ;; this function, but use cider--connected-handler instead.\n  (let ((buffer (or (plist-get params :repl-buffer)\n                    (cider--choose-reusable-repl-buffer params)\n                    (get-buffer-create (generate-new-buffer-name \"*cider-uninitialized-repl*\"))))\n        (ses-name (or (plist-get params :session-name)\n                      (cider-make-session-name params))))\n    (with-current-buffer buffer\n      (setq-local sesman-system 'CIDER)\n      (setq-local default-directory (or (plist-get params :project-dir) default-directory))\n      ;; creates a new session if session with ses-name doesn't already exist\n      (sesman-add-object 'CIDER ses-name buffer 'allow-new)\n      (unless (derived-mode-p 'cider-repl-mode)\n        (cider-repl-mode))\n      (setq nrepl-err-handler #'cider-default-err-handler\n            ;; used as a new-repl marker in cider-set-repl-type\n            mode-name nil\n            cider-session-name ses-name\n            nrepl-project-dir (plist-get params :project-dir)\n            ;; REPLs start with clj and then \"upgrade\" to a different type\n            cider-repl-type (plist-get params :repl-type)\n            ;; ran at the end of cider--connected-handler\n            cider-repl-init-function (plist-get params :repl-init-function)\n            cider-launch-params params)\n      (cider-repl-reset-markers)\n      (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local)\n      (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local)\n      (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local)\n      (current-buffer))))\n\n\f\n;;; Current/other REPLs\n\n(defun cider--no-repls-user-error (type)\n  \"Throw \\\"No REPL\\\" user error customized for TYPE.\"\n  (let ((type (cond\n               ((or (eq type 'multi) (eq type 'any))\n                \"clj or cljs\")\n               ((listp type)\n                (mapconcat #'identity type \" or \"))\n               (type))))\n    (user-error \"No %s REPLs in current session \\\"%s\\\"\"\n                type (car (sesman-current-session 'CIDER)))))\n\n(defun cider-current-repl (&optional type ensure)\n  \"Get the most recent REPL of TYPE from the current session.\nTYPE is either clj, cljs, multi or any.\nWhen nil, infer the type from the current buffer.\nIf ENSURE is non-nil, throw an error if either there is\nno linked session or there is no REPL of TYPE within the current session.\"\n  (let ((type (cider-maybe-intern type)))\n    (if (and (derived-mode-p 'cider-repl-mode)\n             (or (null type)\n                 (eq 'any type)\n                 (eq cider-repl-type type)))\n        ;; shortcut when in REPL buffer\n        (current-buffer)\n      (let* ((type (or type (cider-repl-type-for-buffer)))\n             (repls (cider-repls type ensure))\n             (repl (if (<= (length repls) 1)\n                       (car repls)\n                     ;; pick the most recent one\n                     (seq-find (lambda (b)\n                                 (member b repls))\n                               (buffer-list)))))\n        (if (and ensure (null repl))\n            (cider--no-repls-user-error type)\n          repl)))))\n\n(defun cider--match-repl-type (type buffer)\n  \"Return non-nil if TYPE matches BUFFER's REPL type.\"\n  (let ((buffer-repl-type (cider-repl-type buffer)))\n    (cond ((null buffer-repl-type) nil)\n          ((or (null type) (eq type 'multi) (eq type 'any)) t)\n          ((listp type) (member buffer-repl-type type))\n          (t (string= type buffer-repl-type)))))\n\n(defun cider--get-host-from-session (session)\n  \"Returns the host associated with SESSION.\"\n  (plist-get (cider--gather-session-params session)\n             :host))\n\n(defun cider--make-sessions-list-with-hosts (sessions)\n  \"Makes a list of SESSIONS and their hosts.\nReturns a list of the form ((session1 host1) (session2 host2) ...).\"\n  (mapcar (lambda (session)\n            (list session (cider--get-host-from-session session)))\n          sessions))\n\n(defun cider--get-sessions-with-same-host (session sessions)\n  \"Returns a list of SESSIONS with the same host as SESSION.\"\n  (mapcar #'car\n          (seq-filter (lambda (x)\n                        (string-equal (cadr x)\n                                      (cider--get-host-from-session session)))\n                      (cider--make-sessions-list-with-hosts sessions))))\n\n(defun cider--extract-connections (sessions)\n  \"Returns a flattened list of all session buffers in SESSIONS.\"\n  (cl-reduce (lambda (x y)\n               (append x (cdr y)))\n             sessions\n             :initial-value '()))\n\n(defun cider-repls (&optional type ensure)\n  \"Return cider REPLs of TYPE from the current session.\nIf TYPE is nil or multi, return all REPLs.  If TYPE is a list of types,\nreturn only REPLs of type contained in the list.  If ENSURE is non-nil,\nthrow an error if no linked session exists.\"\n  (let ((type (cond\n               ((listp type)\n                (mapcar #'cider-maybe-intern type))\n               ((cider-maybe-intern type))))\n        (repls (pcase cider-merge-sessions\n                 ('host\n                  (if ensure\n                      (or (cider--extract-connections (cider--get-sessions-with-same-host\n                                                       (sesman-current-session 'CIDER)\n                                                       (sesman-current-sessions 'CIDER)))\n                          (user-error \"No linked %s sessions\" 'CIDER))\n                    (cider--extract-connections (cider--get-sessions-with-same-host\n                                                 (sesman-current-session 'CIDER)\n                                                 (sesman-current-sessions 'CIDER)))))\n                 ('project\n                  (if ensure\n                      (or (cider--extract-connections (sesman-current-sessions 'CIDER))\n                          (user-error \"No linked %s sessions\" 'CIDER))\n                    (cider--extract-connections (sesman-current-sessions 'CIDER))))\n                 (_ (cdr (if ensure\n                             (sesman-ensure-session 'CIDER)\n                           (sesman-current-session 'CIDER)))))))\n    (or (seq-filter (lambda (b)\n                      (cider--match-repl-type type b))\n                    repls)\n        (when ensure\n          (cider--no-repls-user-error type)))))\n\n(defun cider-map-repls (which function)\n  \"Call FUNCTION once for each appropriate REPL as indicated by WHICH.\nThe function is called with one argument, the REPL buffer.  The appropriate\nconnections are found by inspecting the current buffer.  WHICH is one of\nthe following keywords:\n :auto - Act on the connections whose type matches the current buffer.  In\n     `cljc' files, mapping happens over both types of REPLs.\n :clj (:cljs) - Map over clj (cljs)) REPLs only.\n :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a\n      `user-error' in `clojurescript-mode' (`clojure-mode').  Use this for\n      commands only supported in Clojure (ClojureScript).\nError is signaled if no REPL buffers of specified type exist in current\nsession.\"\n  (declare (indent 1))\n  (let ((cur-type (cider-repl-type-for-buffer)))\n    (cl-case which\n      (:clj-strict (when (eq cur-type 'cljs)\n                     (user-error \"Clojure-only operation requested in a ClojureScript buffer\")))\n      (:cljs-strict (when (eq cur-type 'clj)\n                      (user-error \"ClojureScript-only operation requested in a Clojure buffer\"))))\n    (let* ((type (cl-case which\n                   ((:clj :clj-strict) 'clj)\n                   ((:cljs :cljs-strict) 'cljs)\n                   (:auto (if (eq cur-type 'multi)\n                              '(clj cljs)\n                            cur-type))))\n           (ensure (cl-case which\n                     (:auto nil)\n                     (t 'ensure)))\n           (repls (cider-repls type ensure)))\n      (mapcar function repls))))\n\n;; REPLs double as connections in CIDER, so it's useful to be able to refer to\n;; them as connections in certain contexts.\n(defalias 'cider-current-connection #'cider-current-repl)\n(defalias 'cider-connections #'cider-repls)\n(defalias 'cider-map-connections #'cider-map-repls)\n(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer)\n\n;; Deprecated after #2324 (introduction of sesman)\n\n(define-obsolete-function-alias 'cider-current-repl-buffer #'cider-current-repl \"0.18\")\n(define-obsolete-function-alias 'cider-repl-buffers #'cider-repls \"0.18\")\n(define-obsolete-function-alias 'cider-current-session #'cider-nrepl-eval-session \"0.18\")\n(define-obsolete-function-alias 'cider-current-tooling-session #'cider-nrepl-tooling-session \"0.18\")\n(define-obsolete-function-alias 'nrepl-connection-buffer-name #'nrepl-repl-buffer-name \"0.18\")\n\n(provide 'cider-connection)\n\n;;; cider-connection.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-debug.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53397827,"end":53397865},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53397865},"to":{"change":3,"start":53361238,"end":53361238},"introduced_by":3}],"inode":{"change":3,"pos":53361238}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53361238},"to":{"change":3,"start":53361239,"end":53397826},"introduced_by":3}],"inode":{"change":3,"pos":53361238}},"content":[{"Del":";;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware  -*- lexical-binding: t; -*-\n\n;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n\n;; Author: Artur Malabarba \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;; Instrument code with `cider-debug-defun-at-point', and when the code is\n;; executed cider-debug will kick in.  See this function's doc for more\n;; information.\n\n;;; Code:\n\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'spinner)\n\n(require 'cider-browse-ns)\n(require 'cider-client)\n(require 'cider-eval)\n(require 'cider-inspector)\n(require 'cider-util)\n(require 'cider-common)\n(require 'nrepl-client) ; `nrepl--mark-id-completed'\n(require 'nrepl-dict)\n\n\f\n;;; Customization\n(defgroup cider-debug nil\n  \"Presentation and behavior of the cider debugger.\"\n  :prefix \"cider-debug-\"\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defface cider-debug-code-overlay-face\n  '((((class color) (background light)) :background \"grey80\")\n    (((class color) (background dark))  :background \"grey30\"))\n  \"Face used to mark code being debugged.\"\n  :package-version '(cider . \"0.9.1\"))\n\n(defface cider-debug-prompt-face\n  '((t :underline t :inherit font-lock-builtin-face))\n  \"Face used to highlight keys in the debug prompt.\"\n  :package-version '(cider . \"0.10.0\"))\n\n(defface cider-enlightened-face\n  '((((class color) (background light)) :inherit cider-result-overlay-face\n     :box (:color \"darkorange\" :line-width -1))\n    (((class color) (background dark))  :inherit cider-result-overlay-face\n     ;; \"#dd0\" is a dimmer yellow.\n     :box (:color \"#990\" :line-width -1)))\n  \"Face used to mark enlightened sexps and their return values.\"\n  :package-version '(cider . \"0.11.0\"))\n\n(defface cider-enlightened-local-face\n  '((((class color) (background light)) :weight bold :foreground \"darkorange\")\n    (((class color) (background dark))  :weight bold :foreground \"yellow\"))\n  \"Face used to mark enlightened locals (not their values).\"\n  :package-version '(cider . \"0.11.0\"))\n\n(defcustom cider-debug-prompt 'overlay\n  \"If and where to show the keys while debugging.\nIf `minibuffer', show it in the minibuffer along with the return value.\nIf `overlay', show it in an overlay above the current function.\nIf t, do both.\nIf nil, don't list available keys at all.\"\n  :type '(choice (const :tag \"Show in minibuffer\" minibuffer)\n                 (const :tag \"Show above function\" overlay)\n                 (const :tag \"Show in both places\" t)\n                 (const :tag \"Don't list keys\" nil))\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-debug-use-overlays t\n  \"Whether to highlight debugging information with overlays.\nTakes the same possible values as `cider-use-overlays', but only applies to\nvalues displayed during debugging sessions.\nTo control the overlay that lists possible keys above the current function,\nconfigure `cider-debug-prompt' instead.\"\n  :type '(choice (const :tag \"End of line\" t)\n                 (const :tag \"Bottom of screen\" nil)\n                 (const :tag \"Both\" both))\n  :package-version '(cider . \"0.9.1\"))\n\n(make-obsolete 'cider-debug-print-length 'cider-debug-print-options \"0.20\")\n(make-obsolete 'cider-debug-print-level 'cider-debug-print-options \"0.20\")\n(make-obsolete-variable 'cider-debug-print-options 'cider-print-options \"0.21\")\n\n\f\n;;; Implementation\n(declare-function cider-browse-ns--combined-vars-with-meta \"cider-browse-ns\")\n\n(defun cider-browse-instrumented-defs ()\n  \"List all instrumented definitions.\"\n  (interactive)\n  (if-let* ((all (thread-first (cider-nrepl-send-sync-request '(\"op\" \"debug-instrumented-defs\"))\n                               (nrepl-dict-get \"list\"))))\n      (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)\n        (let ((inhibit-read-only t))\n          (dolist (list all)\n            (let* ((ns (car list))\n                   (ns-vars-with-meta (cider-browse-ns--combined-vars-with-meta ns))\n                   (instrumented-meta (nrepl-dict-filter (lambda (k _)\n                                                           (member k list))\n                                                         ns-vars-with-meta)))\n              (cider-browse-ns--list (current-buffer) ns\n                                     instrumented-meta\n                                     ns)))))\n    (message \"No currently instrumented definitions\")))\n\n(defun cider--debug-response-handler (response)\n  \"Handles RESPONSE from the cider.debug middleware.\"\n  (nrepl-dbind-response response (status id causes)\n    (when (member \"enlighten\" status)\n      (cider--handle-enlighten response))\n    (when (or (member \"eval-error\" status)\n              (member \"stack\" status))\n      ;; TODO: Make the error buffer a bit friendlier when we're just printing\n      ;; the stack.\n      (cider--render-stacktrace-causes causes))\n    (when (member \"need-debug-input\" status)\n      (cider--handle-debug response))\n    (when (member \"done\" status)\n      (nrepl--mark-id-completed id))))\n\n(defun cider--debug-init-connection ()\n  \"Initialize a connection with the cider.debug middleware.\"\n  (cider-nrepl-send-request\n   (thread-last\n     (map-merge 'list\n                '((\"op\" \"init-debugger\"))\n                (cider--nrepl-print-request-map fill-column))\n     (seq-mapcat #'identity))\n   #'cider--debug-response-handler))\n\n\f\n;;; Debugging overlays\n(defconst cider--fringe-arrow-string\n  #(\".\" 0 1 (display (left-fringe right-triangle)))\n  \"Used as an overlay's before-string prop to place a fringe arrow.\")\n\n(defun cider--debug-display-result-overlay (value)\n  \"Place an overlay at point displaying VALUE.\"\n  (when cider-debug-use-overlays\n    ;; This is cosmetic, let's ensure it doesn't break the session no matter what.\n    (ignore-errors\n      ;; Result\n      (cider--make-result-overlay (cider-font-lock-as-clojure value)\n        :where (point-marker)\n        :type 'debug-result\n        'before-string cider--fringe-arrow-string)\n      ;; Code\n      (cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point))\n                           (point) 'debug-code\n                           'face 'cider-debug-code-overlay-face\n                           ;; Higher priority than `show-paren'.\n                           'priority 2000))))\n\n\f\n;;; Minor mode\n(defvar-local cider--debug-mode-response nil\n  \"Response that triggered current debug session.\nSet by `cider--turn-on-debug-mode'.\")\n\n(defcustom cider-debug-display-locals nil\n  \"If non-nil, local variables are displayed while debugging.\nCan be toggled at any time with `\\\\[cider-debug-toggle-locals]'.\"\n  :type 'boolean\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-debug-prompt-commands\n  '((?c \"continue\" \"continue\")\n    (?C \"continue-all\" nil)\n    (?n \"next\" \"next\")\n    (?i \"in\" \"in\")\n    (?o \"out\" \"out\")\n    (?O \"force-out\" nil)\n    (?h \"here\" \"here\")\n    (?e \"eval\" \"eval\")\n    (?p \"inspect\" \"inspect\")\n    (?P \"inspect-prompt\" nil)\n    (?l \"locals\" \"locals\")\n    (?j \"inject\" \"inject\")\n    (?s \"stacktrace\" \"stacktrace\")\n    (?t \"trace\" \"trace\")\n    (?q \"quit\" \"quit\"))\n  \"A list of debugger command specs.\n\nSpecs are in the format (KEY COMMAND-NAME DISPLAY-NAME?)  where KEY is a\ncharacter which is mapped to the command COMMAND-NAME is a valid debug\ncommand to be passed to the cider-nrepl middleware DISPLAY-NAME is the\nstring displayed in the debugger overlay\n\nIf DISPLAY-NAME is nil, that command is hidden from the overlay but still\ncallable.  The rest of the commands are displayed in the same order as this\nlist.\"\n  :type '(alist :key-type character\n                :value-type (list\n                             (string :tag \"command name\")\n                             (choice (string :tag \"display name\") nil)))\n  :package-version '(cider . \"0.24.0\"))\n\n(defun cider--debug-format-locals-list (locals)\n  \"Return a string description of list LOCALS.\nEach element of LOCALS should be a list of at least two elements.\"\n  (if locals\n      (let ((left-col-width\n             ;; To right-indent the variable names.\n             (apply #'max (mapcar (lambda (l) (string-width (car l))) locals))))\n        ;; A format string to build a format string. :-P\n        (mapconcat (lambda (l) (format (format \" %%%ds: %%s\\n\" left-col-width)\n                                       (propertize (car l) 'face 'font-lock-variable-name-face)\n                                       (cider-font-lock-as-clojure (cadr l))))\n                   locals \"\"))\n    \"\"))\n\n(defun cider--debug-propertize-prompt-commands ()\n  \"In-place format the command display names for the `cider-debug-prompt' overlay.\"\n  (mapc (lambda (spec)\n          (cl-destructuring-bind (char _cmd disp-name) spec\n            (when-let* ((pos (cl-position char disp-name)))\n              (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face disp-name))))\n        cider-debug-prompt-commands))\n\n(defun cider--debug-prompt (commands)\n  \"Return prompt to display for COMMANDS.\"\n  ;; Force `default' face, otherwise the overlay \"inherits\" the face of the text\n  ;; after it.\n  (format (propertize \"%s\\n\" 'face 'default)\n          (cl-reduce\n           (lambda (prompt spec)\n             (cl-destructuring-bind (_char cmd disp) spec\n               (if (and disp (cl-find cmd commands :test 'string=))\n                   (concat prompt \" \" disp)\n                 prompt)))\n           cider-debug-prompt-commands\n           :initial-value \"\")))\n\n(defvar-local cider--debug-prompt-overlay nil)\n\n(defun cider--debug-mode-redisplay ()\n  \"Display the input prompt to the user.\"\n  (nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals)\n    ;; input-type is an unsorted collection of command names,\n    ;; as sent by `cider.nrepl.middleware.debug/read-debug-input`\n    (when (or (eq cider-debug-prompt t)\n              (eq cider-debug-prompt 'overlay))\n      (if (overlayp cider--debug-prompt-overlay)\n          (overlay-put cider--debug-prompt-overlay\n                       'before-string (cider--debug-prompt input-type))\n        (setq cider--debug-prompt-overlay\n              (cider--make-overlay\n               (max (car (cider-defun-at-point 'bounds))\n                    (window-start))\n               nil 'debug-prompt\n               'before-string (cider--debug-prompt input-type)))))\n    (let* ((value (concat \" \" cider-eval-result-prefix\n                          (cider-font-lock-as-clojure\n                           (or debug-value \"#unknown#\"))))\n           (to-display\n            (concat (when cider-debug-display-locals\n                      (cider--debug-format-locals-list locals))\n                    (when (or (eq cider-debug-prompt t)\n                              (eq cider-debug-prompt 'minibuffer))\n                      (cider--debug-prompt input-type))\n                    (when (or (not cider-debug-use-overlays)\n                              (eq cider-debug-use-overlays 'both))\n                      value))))\n      (if (> (string-width to-display) 0)\n          (message \"%s\" to-display)\n        ;; If there's nothing to display in the minibuffer. Just send the value\n        ;; to the Messages buffer.\n        (message \"%s\" value)\n        (message nil)))))\n\n(defun cider-debug-toggle-locals ()\n  \"Toggle display of local variables.\"\n  (interactive)\n  (setq cider-debug-display-locals (not cider-debug-display-locals))\n  (cider--debug-mode-redisplay))\n\n(defun cider--debug-lexical-eval (key form &optional callback _point)\n  \"Eval FORM in the lexical context of debug session given by KEY.\nDo nothing if CALLBACK is provided.\nDesigned to be used as `cider-interactive-eval-override' and called instead\nof `cider-interactive-eval' in debug sessions.\"\n  ;; The debugger uses its own callback, so if the caller is passing a callback\n  ;; we return nil and let `cider-interactive-eval' do its thing.\n  (unless callback\n    (cider-debug-mode-send-reply (format \"{:response :eval, :code %s}\" form)\n                                 key)\n    t))\n\n(defvar cider--debug-mode-tool-bar-map\n  (let ((tool-bar-map (make-sparse-keymap)))\n    (tool-bar-add-item \"right-arrow\" #'cider-debug-mode-send-reply :next :label \"Next step\")\n    (tool-bar-add-item \"next-node\" #'cider-debug-mode-send-reply :continue :label \"Continue\")\n    (tool-bar-add-item \"jump-to\" #'cider-debug-mode-send-reply :out :label \"Out of sexp\")\n    (tool-bar-add-item \"exit\" #'cider-debug-mode-send-reply :quit :label \"Quit\")\n    tool-bar-map))\n\n(defvar cider--debug-mode-map\n  (let ((map (make-sparse-keymap)))\n    ;; Bind the `:here` command to both h and H, because it behaves differently\n    ;; if invoked with an uppercase letter.\n    (define-key map \"h\" #'cider-debug-move-here)\n    (define-key map \"H\" #'cider-debug-move-here)\n    (define-key map \"L\" #'cider-debug-toggle-locals)\n    map)\n  \"The active keymap during a debugging session.\")\n\n(define-minor-mode cider--debug-mode\n  \"Mode active during debug sessions.\nIn order to work properly, this mode must be activated by\n`cider--turn-on-debug-mode'.\"\n  :init-value nil :lighter \" DEBUG\" :keymap '()\n  (if cider--debug-mode\n      (if cider--debug-mode-response\n          (nrepl-dbind-response cider--debug-mode-response (input-type)\n            ;; A debug session is an ongoing eval, but it's annoying to have the\n            ;; spinner spinning while you debug.\n            (when spinner-current (spinner-stop))\n            (setq-local tool-bar-map cider--debug-mode-tool-bar-map)\n            (add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local)\n            (add-hook 'before-revert-hook #'cider--debug-quit nil 'local)\n            (unless (consp input-type)\n              (error \"Activated debug-mode on a message not asking for commands: %s\" cider--debug-mode-response))\n            ;; Integrate with eval commands.\n            (setq cider-interactive-eval-override\n                  (apply-partially #'cider--debug-lexical-eval\n                                   (nrepl-dict-get cider--debug-mode-response \"key\")))\n            ;; Map over the key->command alist and set the keymap\n            (mapc\n             (lambda (p)\n               (let ((char (car p)))\n                 (unless (= char ?h)   ; `here' needs a special command.\n                   (define-key cider--debug-mode-map (string char) #'cider-debug-mode-send-reply))\n                 (when (= char ?o)\n                   (define-key cider--debug-mode-map (string (upcase ?o)) #'cider-debug-mode-send-reply))))\n             cider-debug-prompt-commands)\n            (cider--debug-propertize-prompt-commands)\n            ;; Show the prompt.\n            (cider--debug-mode-redisplay)\n            ;; If a sync request is ongoing, the user can't act normally to\n            ;; provide input, so we enter `recursive-edit'.\n            (when nrepl-ongoing-sync-request\n              (recursive-edit)))\n        (cider--debug-mode -1)\n        (if (called-interactively-p 'any)\n            (user-error (substitute-command-keys \"Don't call this mode manually, use `\\\\[universal-argument] \\\\[cider-eval-defun-at-point]' instead\"))\n          (error \"Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first\")))\n    (setq cider-interactive-eval-override nil)\n    (setq cider--debug-mode-response nil)\n    ;; We wait a moment before clearing overlays and the read-onlyness, so that\n    ;; cider-nrepl has a chance to send the next message, and so that the user\n    ;; doesn't accidentally hit `n' between two messages (thus editing the code).\n    (when-let* ((proc (unless nrepl-ongoing-sync-request\n                        (get-buffer-process (cider-current-repl)))))\n      (accept-process-output proc 1))\n    (unless cider--debug-mode\n      (setq buffer-read-only nil)\n      (cider--debug-remove-overlays (current-buffer)))\n    (when nrepl-ongoing-sync-request\n      (ignore-errors (exit-recursive-edit)))))\n\n(defun cider--debug-remove-overlays (&optional buffer)\n  \"Remove CIDER debug overlays from BUFFER if variable `cider--debug-mode' is nil.\"\n  (when (or (not buffer) (buffer-live-p buffer))\n    (with-current-buffer (or buffer (current-buffer))\n      (unless cider--debug-mode\n        (kill-local-variable 'tool-bar-map)\n        (remove-overlays nil nil 'category 'debug-result)\n        (remove-overlays nil nil 'category 'debug-code)\n        (setq cider--debug-prompt-overlay nil)\n        (remove-overlays nil nil 'category 'debug-prompt)))))\n\n(defun cider--debug-set-prompt (value)\n  \"Set `cider-debug-prompt' to VALUE, then redisplay.\"\n  (setq cider-debug-prompt value)\n  (cider--debug-mode-redisplay))\n\n(easy-menu-define cider-debug-mode-menu cider--debug-mode-map\n  \"Menu for CIDER debug mode.\"\n  `(\"CIDER Debugger\"\n    [\"Next step\" (cider-debug-mode-send-reply \":next\") :keys \"n\"]\n    [\"Continue\" (cider-debug-mode-send-reply \":continue\") :keys \"c\"]\n    [\"Continue non-stop\" (cider-debug-mode-send-reply \":continue-all\") :keys \"C\"]\n    [\"Move out of sexp\" (cider-debug-mode-send-reply \":out\") :keys \"o\"]\n    [\"Forced move out of sexp\" (cider-debug-mode-send-reply \":out\" nil true) :keys \"O\"]\n    [\"Move to current position\" (cider-debug-mode-send-reply \":here\") :keys \"h\"]\n    [\"Quit\" (cider-debug-mode-send-reply \":quit\") :keys \"q\"]\n    \"--\"\n    [\"Evaluate in current scope\" (cider-debug-mode-send-reply \":eval\") :keys \"e\"]\n    [\"Inject value\" (cider-debug-mode-send-reply \":inject\") :keys \"i\"]\n    [\"Inspect current value\" (cider-debug-mode-send-reply \":inspect\") :keys \"p\"]\n    [\"Inspect expression\" (cider-debug-mode-send-reply \":inspect-prompt\") :keys \"P\"]\n    [\"Inspect local variables\" (cider-debug-mode-send-reply \":locals\") :keys \"l\"]\n    \"--\"\n    (\"Configure keys prompt\"\n     [\"Don't show keys\"     (cider--debug-set-prompt nil)         :style toggle :selected (eq cider-debug-prompt nil)]\n     [\"Show in minibuffer\"  (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)]\n     [\"Show above function\" (cider--debug-set-prompt 'overlay)    :style toggle :selected (eq cider-debug-prompt 'overlay)]\n     [\"Show in both places\" (cider--debug-set-prompt t)           :style toggle :selected (eq cider-debug-prompt t)]\n     \"--\"\n     [\"List locals\" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals])\n    [\"Customize\" (customize-group 'cider-debug)]))\n\n(defun cider--uppercase-command-p ()\n  \"Return non-nil if the last command was uppercase letter.\"\n  (ignore-errors\n    (let ((case-fold-search nil))\n      (string-match \"[[:upper:]]\" (string last-command-event)))))\n\n(defun cider-debug-mode-send-reply (command &optional key force)\n  \"Reply to the message that started current bufer's debugging session.\nCOMMAND is sent as the input option.  KEY can be provided to reply to a\nspecific message.  If FORCE is non-nil, send a \\\"force?\\\" argument in the\nmessage.\"\n  (interactive (list\n                (if (symbolp last-command-event)\n                    (symbol-name last-command-event)\n                  (ignore-errors\n                    (concat \":\" (cadr (assoc last-command-event cider-debug-prompt-commands)))))\n                nil\n                (cider--uppercase-command-p)))\n  (when (and (string-prefix-p \":\" command) force)\n    (setq command (format \"{:response %s :force? true}\" command)))\n  (cider-nrepl-send-unhandled-request\n   `(\"op\" \"debug-input\"\n     \"input\" ,(or command \":quit\")\n     \"key\" ,(or key (nrepl-dict-get cider--debug-mode-response \"key\"))))\n  (ignore-errors (cider--debug-mode -1)))\n\n(defun cider--debug-quit ()\n  \"Send a :quit reply to the debugger.  Used in hooks.\"\n  (when cider--debug-mode\n    (cider-debug-mode-send-reply \":quit\")\n    (message \"Quitting debug session\")))\n\n\f\n;;; Movement logic\n(defconst cider--debug-buffer-format \"*cider-debug %s*\")\n\n(defun cider--debug-trim-code (code)\n  \"Remove whitespace and reader macros from the start of the CODE.\nReturn trimmed CODE.\"\n  (replace-regexp-in-string \"\\\\`#[a-z]+[\\n\\r[:blank:]]*\" \"\" code))\n\n(declare-function cider-set-buffer-ns \"cider-mode\")\n(defun cider--initialize-debug-buffer (code ns id &optional reason)\n  \"Create a new debugging buffer with CODE and namespace NS.\nID is the id of the message that instrumented CODE.\nREASON is a keyword describing why this buffer was necessary.\"\n  (let ((buffer-name (format cider--debug-buffer-format id)))\n    (if-let* ((buffer (get-buffer buffer-name)))\n        (cider-popup-buffer-display buffer 'select)\n      (with-current-buffer (cider-popup-buffer buffer-name 'select\n                                               #'clojure-mode 'ancillary)\n        (cider-set-buffer-ns ns)\n        (setq buffer-undo-list nil)\n        (let ((inhibit-read-only t)\n              (buffer-undo-list t))\n          (erase-buffer)\n          (insert (format \"%s\" (cider--debug-trim-code code)))\n          (when code\n            (insert \"\\n\\n\\n;; We had to create this temporary buffer because we couldn't find the original definition. That probably happened because \"\n                    reason\n                    \".\")\n            (fill-paragraph))\n          (font-lock-ensure)\n          (set-buffer-modified-p nil))))\n    (switch-to-buffer buffer-name)\n    (goto-char (point-min))))\n\n(defun cider--debug-goto-keyval (key)\n  \"Find KEY in current sexp or return nil.\"\n  (when-let* ((limit (ignore-errors (save-excursion (up-list) (point)))))\n    (search-forward-regexp (concat \"\\\\_<\" (regexp-quote key) \"\\\\_>\")\n                           limit 'noerror)))\n\n(defun cider--debug-skip-ignored-forms ()\n  \"Skip past all forms ignored with #_ reader macro.\"\n  ;; Logic taken from `clojure--search-comment-macro-internal'\n  (while (looking-at (concat \"[ ,\\r\\t\\n]*\" clojure--comment-macro-regexp))\n    (let ((md (match-data))\n          (start (match-beginning 1)))\n      (goto-char start)\n      ;; Count how many #_ we got and step by that many sexps\n      (clojure-forward-logical-sexp\n       (count-matches (rx \"#_\") (elt md 0) (elt md 1))))))\n\n(defun cider--debug-move-point (coordinates)\n  \"Place point on after the sexp specified by COORDINATES.\nCOORDINATES is a list of integers that specify how to navigate into the\nsexp that is after point when this function is called.\n\nAs an example, a COORDINATES list of '(1 0 2) means:\n  - enter next sexp then `forward-sexp' once,\n  - enter next sexp,\n  - enter next sexp then `forward-sexp' twice.\n\nIn the following snippet, this takes us to the (* x 2) sexp (point is left\nat the end of the given sexp).\n\n    (letfn [(twice [x]\n              (* x 2))]\n      (twice 15))\n\nIn addition to numbers, a coordinate can be a string.  This string names the\nkey of a map, and it means \\\"go to the value associated with this key\\\".\"\n  (condition-case-unless-debug nil\n      ;; Navigate through sexps inside the sexp.\n      (let ((in-syntax-quote nil))\n        (while coordinates\n          (while (clojure--looking-at-non-logical-sexp)\n            (forward-sexp))\n          ;; An `@x` is read as (deref x), so we pop coordinates once to account\n          ;; for the extra depth, and move past the @ char.\n          (if (eq ?@ (char-after))\n              (progn (forward-char 1)\n                     (pop coordinates))\n            (down-list)\n            ;; Are we entering a syntax-quote?\n            (when (looking-back \"`\\\\(#{\\\\|[{[(]\\\\)\" (line-beginning-position))\n              ;; If we are, this affects all nested structures until the next `~',\n              ;; so we set this variable for all following steps in the loop.\n              (setq in-syntax-quote t))\n            (when in-syntax-quote\n              ;; A `(. .) is read as (seq (concat (list .) (list .))). This pops\n              ;; the `seq', since the real coordinates are inside the `concat'.\n              (pop coordinates)\n              ;; Non-list seqs like `[] and `{} are read with\n              ;; an extra (apply vector ...), so pop it too.\n              (unless (eq ?\\( (char-before))\n                (pop coordinates)))\n            ;; #(...) is read as (fn* ([] ...)), so we patch that here.\n            (when (looking-back \"#(\" (line-beginning-position))\n              (pop coordinates))\n            (if coordinates\n                (let ((next (pop coordinates)))\n                  (when in-syntax-quote\n                    ;; We're inside the `concat' form, but we need to discard the\n                    ;; actual `concat' symbol from the coordinate.\n                    (setq next (1- next)))\n                  ;; String coordinates are map keys.\n                  (if (stringp next)\n                      (cider--debug-goto-keyval next)\n                    (clojure-forward-logical-sexp next)\n                    (when in-syntax-quote\n                      (clojure-forward-logical-sexp 1)\n                      (forward-sexp -1)\n                      ;; Here a syntax-quote is ending.\n                      (let ((match (when (looking-at \"~@?\")\n                                     (match-string 0))))\n                        (when match\n                          (setq in-syntax-quote nil))\n                        ;; A `~@' is read as the object itself, so we don't pop\n                        ;; anything.\n                        (unless (equal \"~@\" match)\n                          ;; Anything else (including a `~') is read as a `list'\n                          ;; form inside the `concat', so we need to pop the list\n                          ;; from the coordinates.\n                          (pop coordinates))))))\n              ;; If that extra pop was the last coordinate, this represents the\n              ;; entire #(...), so we should move back out.\n              (backward-up-list)))\n          ;; Finally skip past all #_ forms\n          (cider--debug-skip-ignored-forms))\n        ;; Place point at the end of instrumented sexp.\n        (clojure-forward-logical-sexp 1))\n    ;; Avoid throwing actual errors, since this happens on every breakpoint.\n    (error (message \"Can't find instrumented sexp, did you edit the source?\"))))\n\n(defun cider--debug-position-for-code (code)\n  \"Return non-nil if point is roughly before CODE.\nThis might move point one line above.\"\n  (or (looking-at-p (regexp-quote code))\n      (let ((trimmed (regexp-quote (cider--debug-trim-code code))))\n        (or (looking-at-p trimmed)\n            ;; If this is a fake #dbg injected by `C-u\n            ;; C-M-x', then the sexp we want is actually on\n            ;; the line above.\n            (progn (forward-line -1)\n                   (looking-at-p trimmed))))))\n\n(defun cider--debug-find-source-position (response &optional create-if-needed)\n  \"Return a marker of the position after the sexp specified in RESPONSE.\nThis marker might be in a different buffer!  If the sexp can't be\nfound (file that contains the code is no longer visited or has been\nedited), return nil.  However, if CREATE-IF-NEEDED is non-nil, a new buffer\nis created in this situation and the return value is never nil.\n\nFollow the \\\"line\\\" and \\\"column\\\" entries in RESPONSE, and check whether\nthe code at point matches the \\\"code\\\" entry in RESPONSE.  If it doesn't,\nassume that the code in this file has been edited, and create a temp buffer\nholding the original code.\nEither way, navigate inside the code by following the \\\"coor\\\" entry which\nis a coordinate measure in sexps.\"\n  (nrepl-dbind-response response (code file line column ns original-id coor)\n    (when (or code (and file line column))\n      ;; This is for restoring current-buffer.\n      (save-excursion\n        (let ((out))\n          ;; We prefer in-source debugging.\n          (when-let* ((buf (and file line column\n                                (ignore-errors\n                                  (cider--find-buffer-for-file file)))))\n            ;; The logic here makes it hard to use `with-current-buffer'.\n            (with-current-buffer buf\n              ;; This is for restoring point inside buf.\n              (save-excursion\n                ;; Get to the proper line & column in the file\n                (forward-line (- line (line-number-at-pos)))\n                ;; Column numbers in the response start from 1.\n                ;; Convert to Emacs system which starts from 0\n                ;; Inverse of `cider-column-number-at-pos'.\n                (move-to-column (max 0 (1- column)))\n                ;; Check if it worked\n                (when (cider--debug-position-for-code code)\n                  ;; Find the desired sexp.\n                  (cider--debug-move-point coor)\n                  (setq out (point-marker))))))\n          ;; But we can create a temp buffer if that fails.\n          (or out\n              (when create-if-needed\n                (cider--initialize-debug-buffer\n                 code ns original-id\n                 (if (and line column)\n                     \"you edited the code\"\n                   \"your nREPL version is older than 0.2.11\"))\n                (save-excursion\n                  (cider--debug-move-point coor)\n                  (point-marker)))))))))\n\n(defun cider--handle-debug (response)\n  \"Handle debugging notification.\nRESPONSE is a message received from the nrepl describing the input\nneeded.  It is expected to contain at least \\\"key\\\", \\\"input-type\\\", and\n\\\"prompt\\\", and possibly other entries depending on the input-type.\"\n  (nrepl-dbind-response response (debug-value key input-type prompt inspect)\n    (condition-case-unless-debug e\n        (progn\n          (pcase input-type\n            (\"expression\" (cider-debug-mode-send-reply\n                           (condition-case nil\n                               (cider-read-from-minibuffer\n                                (or prompt \"Expression: \"))\n                             (quit \"nil\"))\n                           key))\n            ((pred sequencep)\n             (let* ((marker (cider--debug-find-source-position response 'create-if-needed)))\n               (pop-to-buffer (marker-buffer marker))\n               (goto-char marker))\n             ;; The overlay code relies on window boundaries, but point could have been\n             ;; moved outside the window by some other code. Redisplay here to ensure the\n             ;; visible window includes point.\n             (redisplay)\n             ;; Remove overlays AFTER redisplaying! Otherwise there's a visible\n             ;; flicker even if we immediately recreate the overlays.\n             (cider--debug-remove-overlays)\n             (when cider-debug-use-overlays\n               (cider--debug-display-result-overlay debug-value))\n             (setq cider--debug-mode-response response)\n             (cider--debug-mode 1)))\n          (when inspect\n            (setq cider-inspector--current-repl (cider-current-repl))\n            (cider-inspector--render-value inspect)))\n      ;; If something goes wrong, we send a \"quit\" or the session hangs.\n      (error (cider-debug-mode-send-reply \":quit\" key)\n             (message \"Error encountered while handling the debug message: %S\" e)))))\n\n(defun cider--handle-enlighten (response)\n  \"Handle an enlighten notification.\nRESPONSE is a message received from the nrepl describing the value and\ncoordinates of a sexp.  Create an overlay after the specified sexp\ndisplaying its value.\"\n  (when-let* ((marker (cider--debug-find-source-position response)))\n    (with-current-buffer (marker-buffer marker)\n      (save-excursion\n        (goto-char marker)\n        (clojure-backward-logical-sexp 1)\n        (nrepl-dbind-response response (debug-value erase-previous)\n          (when erase-previous\n            (remove-overlays (point) marker 'category 'enlighten))\n          (when debug-value\n            (if (memq (char-before marker) '(?\\) ?\\] ?}))\n                ;; Enlightening a sexp looks like a regular return value, except\n                ;; for a different border.\n                (cider--make-result-overlay (cider-font-lock-as-clojure debug-value)\n                  :where (cons marker marker)\n                  :type 'enlighten\n                  :prepend-face 'cider-enlightened-face)\n              ;; Enlightening a symbol uses a more abbreviated format. The\n              ;; result face is the same as a regular result, but we also color\n              ;; the symbol with `cider-enlightened-local-face'.\n              (cider--make-result-overlay (cider-font-lock-as-clojure debug-value)\n                :format \"%s\"\n                :where (cons (point) marker)\n                :type 'enlighten\n                'face 'cider-enlightened-local-face))))))))\n\n\f\n;;; Move here command\n;; This is the inverse of `cider--debug-move-point'.  However, that algorithm is\n;; complicated, and trying to code its inverse would probably be insane.\n;; Instead, we find the coordinate by trial and error.\n(defun cider--debug-find-coordinates-for-point (target &optional list-so-far)\n  \"Return the coordinates list for reaching TARGET.\nAssumes that the next thing after point is a logical Clojure sexp and that\nTARGET is inside it.  The returned list is suitable for use in\n`cider--debug-move-point'.  LIST-SO-FAR is for internal use.\"\n  (when (looking-at (rx (or \"(\" \"[\" \"#{\" \"{\")))\n    (let ((starting-point (point)))\n      (unwind-protect\n          (let ((x 0))\n            ;; Keep incrementing the last coordinate until we've moved\n            ;; past TARGET.\n            (while (condition-case nil\n                       (progn (goto-char starting-point)\n                              (cider--debug-move-point (append list-so-far (list x)))\n                              (< (point) target))\n                     ;; Not a valid coordinate. Move back a step and stop here.\n                     (scan-error (setq x (1- x))\n                                 nil))\n              (setq x (1+ x)))\n            (setq list-so-far (append list-so-far (list x)))\n            ;; We have moved past TARGET, now determine whether we should\n            ;; stop, or if target is deeper inside the previous sexp.\n            (if (or (= target (point))\n                    (progn (forward-sexp -1)\n                           (<= target (point))))\n                list-so-far\n              (goto-char starting-point)\n              (cider--debug-find-coordinates-for-point target list-so-far)))\n        ;; `unwind-protect' clause.\n        (goto-char starting-point)))))\n\n(defun cider-debug-move-here (&optional force)\n  \"Skip any breakpoints up to point.\nThe boolean value of FORCE will be sent in the reply.\"\n  (interactive (list (cider--uppercase-command-p)))\n  (unless cider--debug-mode\n    (user-error \"`cider-debug-move-here' only makes sense during a debug session\"))\n  (let ((here (point)))\n    (nrepl-dbind-response cider--debug-mode-response (line column)\n      (if (and line column (buffer-file-name))\n          (progn ;; Get to the proper line & column in the file\n            (forward-line (1- (- line (line-number-at-pos))))\n            (move-to-column column))\n        (beginning-of-defun))\n      ;; Is HERE inside the sexp being debugged?\n      (when (or (< here (point))\n                (save-excursion\n                  (forward-sexp 1)\n                  (> here (point))))\n        (user-error \"Point is outside the sexp being debugged\"))\n      ;; Move forward until start of sexp.\n      (comment-normalize-vars)\n      (comment-forward (point-max))\n      ;; Find the coordinate and send it.\n      (cider-debug-mode-send-reply\n       (format \"{:response :here, :coord %s :force? %s}\"\n               (cider--debug-find-coordinates-for-point here)\n               (if force \"true\" \"false\"))))))\n\n\f\n;;; User commands\n;;;###autoload\n(defun cider-debug-defun-at-point ()\n  \"Instrument the \\\"top-level\\\" expression at point.\nIf it is a defn, dispatch the instrumented definition.  Otherwise,\nimmediately evaluate the instrumented expression.\n\nWhile debugged code is being evaluated, the user is taken through the\nsource code and displayed the value of various expressions.  At each step,\na number of keys will be prompted to the user.\"\n  (interactive)\n  (cider-eval-defun-at-point 'debug-it))\n\n(provide 'cider-debug)\n;;; cider-debug.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-doc.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53361200,"end":53361236},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53361236},"to":{"change":3,"start":53340100,"end":53340100},"introduced_by":3}],"inode":{"change":3,"pos":53340100}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53340100},"to":{"change":3,"start":53340101,"end":53361199},"introduced_by":3}],"inode":{"change":3,"pos":53340100}},"content":[{"Del":";;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Bozhidar Batsov, Jeff Valk and CIDER contributors\n\n;; Author: Jeff Valk \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Mode for formatting and presenting documentation\n\n;;; Code:\n\n(require 'cider-common)\n(require 'subr-x)\n(require 'cider-util)\n(require 'cider-popup)\n(require 'cider-client)\n(require 'cider-clojuredocs)\n(require 'nrepl-dict)\n(require 'button)\n(require 'easymenu)\n(require 'cider-browse-spec)\n\n;; we defer loading those, as org-table is a big library\n(declare-function org-table-map-tables \"org-table\")\n(declare-function org-table-align \"org-table\")\n(declare-function org-table-begin \"org-table\")\n(declare-function org-table-end \"org-table\")\n\n\f\n;;; Variables\n\n(defgroup cider-doc nil\n  \"Documentation for CIDER.\"\n  :prefix \"cider-doc-\"\n  :group 'cider)\n\n(defcustom cider-doc-auto-select-buffer t\n  \"Controls whether to auto-select the doc popup buffer.\"\n  :type 'boolean\n  :group 'cider-doc\n  :package-version  '(cider . \"0.15.0\"))\n\n(declare-function cider-apropos \"cider-apropos\")\n(declare-function cider-apropos-select \"cider-apropos\")\n(declare-function cider-apropos-documentation \"cider-apropos\")\n(declare-function cider-apropos-documentation-select \"cider-apropos\")\n\n(defvar cider-doc-map\n  (let (cider-doc-map)\n    (define-prefix-command 'cider-doc-map)\n    (define-key cider-doc-map (kbd \"a\") #'cider-apropos)\n    (define-key cider-doc-map (kbd \"C-a\") #'cider-apropos)\n    (define-key cider-doc-map (kbd \"s\") #'cider-apropos-select)\n    (define-key cider-doc-map (kbd \"C-s\") #'cider-apropos-select)\n    (define-key cider-doc-map (kbd \"f\") #'cider-apropos-documentation)\n    (define-key cider-doc-map (kbd \"C-f\") #'cider-apropos-documentation)\n    (define-key cider-doc-map (kbd \"e\") #'cider-apropos-documentation-select)\n    (define-key cider-doc-map (kbd \"C-e\") #'cider-apropos-documentation-select)\n    (define-key cider-doc-map (kbd \"d\") #'cider-doc)\n    (define-key cider-doc-map (kbd \"C-d\") #'cider-doc)\n    (define-key cider-doc-map (kbd \"c\") #'cider-clojuredocs)\n    (define-key cider-doc-map (kbd \"C-c\") #'cider-clojuredocs)\n    (define-key cider-doc-map (kbd \"w\") #'cider-clojuredocs-web)\n    (define-key cider-doc-map (kbd \"C-w\") #'cider-clojuredocs-web)\n    (define-key cider-doc-map (kbd \"j\") #'cider-javadoc)\n    (define-key cider-doc-map (kbd \"C-j\") #'cider-javadoc)\n    cider-doc-map)\n  \"CIDER documentation keymap.\")\n\n(defconst cider-doc-menu\n  '(\"Documentation\"\n    [\"CiderDoc\" cider-doc]\n    [\"JavaDoc in browser\" cider-javadoc]\n    \"--\"\n    [\"Clojuredocs\" cider-clojuredocs]\n    [\"Clojuredocs in browser\" cider-clojuredocs-web]\n    [\"Refresh ClojureDocs cache\" cider-clojuredocs-refresh-cache]\n    \"--\"\n    [\"Search symbols\" cider-apropos]\n    [\"Search symbols & select\" cider-apropos-select]\n    [\"Search documentation\" cider-apropos-documentation]\n    [\"Search documentation & select\" cider-apropos-documentation-select]\n    \"--\"\n    [\"Configure Doc buffer\" (customize-group 'cider-docview-mode)])\n  \"CIDER documentation submenu.\")\n\n\f\n;;; cider-docview-mode\n\n(defgroup cider-docview-mode nil\n  \"Formatting/fontifying documentation viewer.\"\n  :prefix \"cider-docview-\"\n  :group 'cider)\n\n(defcustom cider-docview-fill-column fill-column\n  \"Fill column for docstrings in doc buffer.\"\n  :type 'list\n  :group 'cider-docview-mode\n  :package-version '(cider . \"0.7.0\"))\n\n\f\n;; Faces\n\n(defface cider-docview-emphasis-face\n  '((t (:inherit default :underline t)))\n  \"Face for emphasized text.\"\n  :group 'cider-docview-mode\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-docview-strong-face\n  '((t (:inherit default :underline t :weight bold)))\n  \"Face for strongly emphasized text.\"\n  :group 'cider-docview-mode\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-docview-literal-face\n  '((t (:inherit font-lock-string-face)))\n  \"Face for literal text.\"\n  :group 'cider-docview-mode\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-docview-table-border-face\n  '((t (:inherit shadow)))\n  \"Face for table borders.\"\n  :group 'cider-docview-mode\n  :package-version '(cider . \"0.7.0\"))\n\n\f\n;; Colors & Theme Support\n\n(defvar cider-docview-code-background-color\n  (cider-scale-background-color)\n  \"Background color for code blocks.\")\n\n(advice-add 'enable-theme  :after #'cider--docview-adapt-to-theme)\n(advice-add 'disable-theme :after #'cider--docview-adapt-to-theme)\n(defun cider--docview-adapt-to-theme (&rest _)\n  \"When theme is changed, update `cider-docview-code-background-color'.\"\n  (setq cider-docview-code-background-color (cider-scale-background-color)))\n\f\n;; Mode & key bindings\n\n(defvar cider-docview-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map \"q\" #'cider-popup-buffer-quit-function)\n    (define-key map \"g\" #'cider-docview-clojuredocs)\n    (define-key map \"G\" #'cider-docview-clojuredocs-web)\n    (define-key map \"j\" #'cider-docview-javadoc)\n    (define-key map \"s\" #'cider-docview-source)\n    (define-key map (kbd \"\") #'backward-button)\n    (define-key map (kbd \"TAB\") #'forward-button)\n    (easy-menu-define cider-docview-mode-menu map\n      \"Menu for CIDER's doc mode\"\n      `(\"CiderDoc\"\n        [\"Look up in Clojuredocs\" cider-docview-clojuredocs]\n        [\"Look up in Clojuredocs (browser)\" cider-docview-clojuredocs-web]\n        [\"JavaDoc in browser\" cider-docview-javadoc]\n        [\"Jump to source\" cider-docview-source]\n        \"--\"\n        [\"Quit\" cider-popup-buffer-quit-function]\n        ))\n    map))\n\n(defvar cider-docview-symbol)\n(defvar cider-docview-javadoc-url)\n(defvar cider-docview-file)\n(defvar cider-docview-line)\n\n(define-derived-mode cider-docview-mode help-mode \"Doc\"\n  \"Major mode for displaying CIDER documentation.\n\n\\\\{cider-docview-mode-map}\"\n  (setq buffer-read-only t)\n  (setq-local sesman-system 'CIDER)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t))\n  (setq-local electric-indent-chars nil)\n  (setq-local cider-docview-symbol nil)\n  (setq-local cider-docview-javadoc-url nil)\n  (setq-local cider-docview-file nil)\n  (setq-local cider-docview-line nil))\n\n\f\n;;; Interactive functions\n\n(defun cider-docview-javadoc ()\n  \"Open the Javadoc for the current class, if available.\"\n  (interactive)\n  (if cider-docview-javadoc-url\n      (browse-url cider-docview-javadoc-url)\n    (error \"No Javadoc available for %s\" cider-docview-symbol)))\n\n(defun cider-javadoc-handler (symbol-name)\n  \"Invoke the nREPL \\\"info\\\" op on SYMBOL-NAME if available.\"\n  (when symbol-name\n    (let* ((info (cider-var-info symbol-name))\n           (url (nrepl-dict-get info \"javadoc\")))\n      (if url\n          (browse-url url)\n        (user-error \"No Javadoc available for %s\" symbol-name)))))\n\n(defun cider-javadoc (arg)\n  \"Open Javadoc documentation in a popup buffer.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\"\n  (interactive \"P\")\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"info\")\n  (funcall (cider-prompt-for-symbol-function arg)\n           \"Javadoc for\"\n           #'cider-javadoc-handler))\n\n(defun cider-docview-source ()\n  \"Open the source for the current symbol, if available.\"\n  (interactive)\n  (if cider-docview-file\n      (if-let* ((buffer (and (not (cider--tooling-file-p cider-docview-file))\n                             (cider-find-file cider-docview-file))))\n          (cider-jump-to buffer (if cider-docview-line\n                                    (cons cider-docview-line nil)\n                                  cider-docview-symbol)\n                         nil)\n        (user-error\n         (substitute-command-keys\n          \"Can't find the source because it wasn't defined with `cider-eval-buffer'\")))\n    (error \"No source location for %s\" cider-docview-symbol)))\n\n(defvar cider-buffer-ns)\n\n(declare-function cider-clojuredocs-lookup \"cider-clojuredocs\")\n\n(defun cider-docview-clojuredocs ()\n  \"Return the clojuredocs documentation for `cider-docview-symbol'.\"\n  (interactive)\n  (if cider-buffer-ns\n      (cider-clojuredocs-lookup cider-docview-symbol)\n    (error \"%s cannot be looked up on ClojureDocs\" cider-docview-symbol)))\n\n(declare-function cider-clojuredocs-web-lookup \"cider-clojuredocs\")\n\n(defun cider-docview-clojuredocs-web ()\n  \"Open the clojuredocs documentation for `cider-docview-symbol' in a web browser.\"\n  (interactive)\n  (if cider-buffer-ns\n      (cider-clojuredocs-web-lookup cider-docview-symbol)\n    (error \"%s cannot be looked up on ClojureDocs\" cider-docview-symbol)))\n\n(defconst cider-doc-buffer \"*cider-doc*\")\n\n(defun cider-create-doc-buffer (symbol)\n  \"Populates *cider-doc* with the documentation for SYMBOL.\"\n  (when-let* ((info (cider-var-info symbol)))\n    (cider-docview-render (cider-make-popup-buffer cider-doc-buffer nil 'ancillary) symbol info)))\n\n(defun cider-doc-lookup (symbol)\n  \"Look up documentation for SYMBOL.\"\n  (if-let* ((buffer (cider-create-doc-buffer symbol)))\n      (cider-popup-buffer-display buffer cider-doc-auto-select-buffer)\n    (user-error \"Symbol %s not resolved\" symbol)))\n\n(defun cider-doc (&optional arg)\n  \"Open Clojure documentation in a popup buffer.\n\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\"\n  (interactive \"P\")\n  (cider-ensure-connected)\n  (funcall (cider-prompt-for-symbol-function arg)\n           \"Doc for\"\n           #'cider-doc-lookup))\n\n\f\n;;; Font Lock and Formatting\n\n(defun cider-docview-fontify-code-blocks (buffer mode)\n  \"Font lock BUFFER code blocks using MODE and remove markdown characters.\nThis processes the triple backtick GFM markdown extension.  An overlay is used\nto shade the background.  Blocks are marked to be ignored by other fonification\nand line wrap.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (while (search-forward-regexp \"```\\n\" nil t)\n        (replace-match \"\")\n        (let ((beg (point))\n              (bg `(:background ,cider-docview-code-background-color)))\n          (when (search-forward-regexp \"```\\n\" nil t)\n            (replace-match \"\")\n            (cider-font-lock-region-as mode beg (point))\n            (overlay-put (make-overlay beg (point)) 'font-lock-face bg)\n            (put-text-property beg (point) 'block 'code)))))))\n\n(defun cider-docview-fontify-literals (buffer)\n  \"Font lock BUFFER literal text and remove backtick markdown characters.\nPreformatted code text blocks are ignored.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (while (search-forward \"`\" nil t)\n        (if (eq (get-text-property (point) 'block) 'code)\n            (forward-char)\n          (progn\n            (replace-match \"\")\n            (let ((beg (point)))\n              (when (search-forward \"`\" (line-end-position) t)\n                (replace-match \"\")\n                (put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face)))))))))\n\n(defun cider-docview-fontify-emphasis (buffer)\n  \"Font lock BUFFER emphasized text and remove markdown characters.\nOne '*' represents emphasis, multiple '**'s represent strong emphasis.\nPreformatted code text blocks are ignored.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (while (search-forward-regexp \"\\\\(*+\\\\)\\\\(\\\\w\\\\)\" nil t)\n        (if (eq (get-text-property (point) 'block) 'code)\n            (forward-char)\n          (progn\n            (replace-match \"\\\\2\")\n            (let ((beg (1- (point)))\n                  (face (if (> (length (match-string 1)) 1)\n                            'cider-docview-strong-face\n                          'cider-docview-emphasis-face)))\n              (when (search-forward-regexp \"\\\\(\\\\w\\\\)\\\\*+\" (line-end-position) t)\n                (replace-match \"\\\\1\")\n                (put-text-property beg (point) 'font-lock-face face)))))))))\n\n(defun cider-docview-format-tables (buffer)\n  \"Align BUFFER tables and dim borders.\nThis processes the GFM table markdown extension using `org-table'.\nTables are marked to be ignored by line wrap.\"\n  (require 'org-table)\n  (with-current-buffer buffer\n    (save-excursion\n      (let ((border 'cider-docview-table-border-face))\n        (org-table-map-tables\n         (lambda ()\n           (org-table-align)\n           (goto-char (org-table-begin))\n           (while (search-forward-regexp \"[+|-]\" (org-table-end) t)\n             (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border))\n           (put-text-property (org-table-begin) (org-table-end) 'block 'table)))))))\n\n(defun cider-docview-wrap-text (buffer)\n  \"For text in BUFFER not propertized as 'block', apply line wrap.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (while (not (eobp))\n        (unless (get-text-property (point) 'block)\n          (fill-region (point) (line-end-position)))\n        (forward-line)))))\n\n\f\n;;; Rendering\n\n(defun cider-docview-render-java-doc (buffer text)\n  \"Emit into BUFFER formatted doc TEXT for a Java class or member.\"\n  (with-current-buffer buffer\n    (let ((beg (point)))\n      (insert text)\n      (save-excursion\n        (goto-char beg)\n        (cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter\n        (cider-docview-fontify-literals buffer)\n        (cider-docview-fontify-emphasis buffer)\n        (cider-docview-format-tables buffer) ; may contain literals, emphasis\n        (cider-docview-wrap-text buffer))))) ; ignores code, table blocks\n\n(defun cider--abbreviate-file-protocol (file-with-protocol)\n  \"Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL.\"\n  (if (string-match \"\\\\`file:\\\\(.*\\\\)\" file-with-protocol)\n      (let ((file (match-string 1 file-with-protocol))\n            (proj-dir (clojure-project-dir)))\n        (if (and proj-dir\n                 (file-in-directory-p file proj-dir))\n            (file-relative-name file proj-dir)\n          file))\n    file-with-protocol))\n\n(defun cider-docview-render-info (buffer info)\n  \"Emit into BUFFER formatted INFO for the Clojure or Java symbol.\"\n  (let* ((ns      (nrepl-dict-get info \"ns\"))\n         (name    (nrepl-dict-get info \"name\"))\n         (added   (nrepl-dict-get info \"added\"))\n         (depr    (nrepl-dict-get info \"deprecated\"))\n         (macro   (nrepl-dict-get info \"macro\"))\n         (special (nrepl-dict-get info \"special-form\"))\n         (builtin (nrepl-dict-get info \"built-in\")) ;; babashka specific\n         (forms   (when-let* ((str (nrepl-dict-get info \"forms-str\")))\n                    (split-string str \"\\n\")))\n         (args    (when-let* ((str (nrepl-dict-get info \"arglists-str\")))\n                    (split-string str \"\\n\")))\n         (doc     (or (nrepl-dict-get info \"doc\")\n                      \"Not documented.\"))\n         (url     (nrepl-dict-get info \"url\"))\n         (class   (nrepl-dict-get info \"class\"))\n         (member  (nrepl-dict-get info \"member\"))\n         (javadoc (nrepl-dict-get info \"javadoc\"))\n         (super   (nrepl-dict-get info \"super\"))\n         (ifaces  (nrepl-dict-get info \"interfaces\"))\n         (spec    (nrepl-dict-get info \"spec\"))\n         (clj-name  (if ns (concat ns \"/\" name) name))\n         (java-name (if member (concat class \"/\" member) class))\n         (see-also (nrepl-dict-get info \"see-also\")))\n    (cider--help-setup-xref (list #'cider-doc-lookup (format \"%s/%s\" ns name)) nil buffer)\n    (with-current-buffer buffer\n      (cl-flet ((emit (text &optional face)\n                      (insert (if face\n                                  (propertize text 'font-lock-face face)\n                                text)\n                              \"\\n\")))\n        (emit (if class java-name clj-name) 'font-lock-function-name-face)\n        (when super\n          (emit (concat \"   Extends: \" (cider-font-lock-as 'java-mode super))))\n        (when ifaces\n          (emit (concat \"Implements: \" (cider-font-lock-as 'java-mode (car ifaces))))\n          (dolist (iface (cdr ifaces))\n            (emit (concat \"            \"(cider-font-lock-as 'java-mode iface)))))\n        (when (or super ifaces)\n          (insert \"\\n\"))\n        (when-let* ((forms (or forms args)))\n          (dolist (form forms)\n            (insert \" \")\n            (emit (cider-font-lock-as-clojure form))))\n        (when special\n          (emit \"Special Form\" 'font-lock-keyword-face))\n        (when macro\n          (emit \"Macro\" 'font-lock-variable-name-face))\n        (when builtin\n          (emit \"Built-in\" 'font-lock-keyword-face))\n        (when added\n          (emit (concat \"Added in \" added) 'font-lock-comment-face))\n        (when depr\n          (emit (concat \"Deprecated in \" depr) 'font-lock-keyword-face))\n        (if class\n            (cider-docview-render-java-doc (current-buffer) doc)\n          (emit (concat \"  \" doc)))\n        (when url\n          (insert \"\\n  Please see \")\n          (insert-text-button url\n                              'url url\n                              'follow-link t\n                              'action (lambda (x)\n                                        (browse-url (button-get x 'url))))\n          (insert \"\\n\"))\n        (when javadoc\n          (insert \"\\n\\nFor additional documentation, see the \")\n          (insert-text-button \"Javadoc\"\n                              'url javadoc\n                              'follow-link t\n                              'action (lambda (x)\n                                        (browse-url (button-get x 'url))))\n          (insert \".\\n\"))\n        (insert \"\\n\")\n        (when spec\n          (emit \"Spec:\" 'font-lock-function-name-face)\n          (insert (cider-browse-spec--pprint-indented spec))\n          (insert \"\\n\\n\")\n          (insert-text-button \"Browse spec\"\n                              'follow-link t\n                              'action (lambda (_)\n                                        (cider-browse-spec (format \"%s/%s\" ns name))))\n          (insert \"\\n\\n\"))\n        (if (and cider-docview-file (not (string= cider-docview-file \"\")))\n            (progn\n              (insert (propertize (if class java-name clj-name)\n                                  'font-lock-face 'font-lock-function-name-face)\n                      \" is defined in \")\n              (insert-text-button (cider--abbreviate-file-protocol cider-docview-file)\n                                  'follow-link t\n                                  'action (lambda (_x)\n                                            (cider-docview-source)))\n              (insert \".\"))\n          (insert \"Definition location unavailable.\"))\n        (when see-also\n          (insert \"\\n\\n Also see: \")\n          (mapc (lambda (ns-sym)\n                  (let* ((ns-sym-split (split-string ns-sym \"/\"))\n                         (see-also-ns (car ns-sym-split))\n                         (see-also-sym (cadr ns-sym-split))\n                         ;; if the var belongs to the same namespace,\n                         ;; we omit the namespace to save some screen space\n                         (symbol (if (equal ns see-also-ns) see-also-sym ns-sym)))\n                    (insert-text-button symbol\n                                        'type 'help-xref\n                                        'help-function (apply-partially #'cider-doc-lookup symbol)))\n                  (insert \" \"))\n                see-also))\n        (cider--doc-make-xrefs)\n        (let ((beg (point-min))\n              (end (point-max)))\n          (nrepl-dict-map (lambda (k v)\n                            (put-text-property beg end k v))\n                          info)))\n      (current-buffer))))\n\n(declare-function cider-set-buffer-ns \"cider-mode\")\n(defun cider-docview-render (buffer symbol info)\n  \"Emit into BUFFER formatted documentation for SYMBOL's INFO.\"\n  (with-current-buffer buffer\n    (let ((javadoc (nrepl-dict-get info \"javadoc\"))\n          (file (nrepl-dict-get info \"file\"))\n          (line (nrepl-dict-get info \"line\"))\n          (ns (nrepl-dict-get info \"ns\"))\n          (inhibit-read-only t))\n      (cider-docview-mode)\n\n      (cider-set-buffer-ns ns)\n      (setq-local cider-docview-symbol symbol)\n      (setq-local cider-docview-javadoc-url javadoc)\n      (setq-local cider-docview-file file)\n      (setq-local cider-docview-line line)\n\n      (remove-overlays)\n      (cider-docview-render-info buffer info)\n\n      (goto-char (point-min))\n      (current-buffer))))\n\n\n(provide 'cider-doc)\n\n;;; cider-doc.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-eldoc.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53340060,"end":53340098},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53340098},"to":{"change":3,"start":53318364,"end":53318364},"introduced_by":3}],"inode":{"change":3,"pos":53318364}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53318364},"to":{"change":3,"start":53318365,"end":53340059},"introduced_by":3}],"inode":{"change":3,"pos":53318364}},"content":[{"Del":";;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; eldoc support for Clojure.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-common) ; for cider-symbol-at-point\n(require 'subr-x)\n(require 'cider-util)\n(require 'nrepl-dict)\n\n(require 'seq)\n\n(require 'eldoc)\n\n(defvar cider-extra-eldoc-commands '(\"yas-expand\")\n  \"Extra commands to be added to eldoc's safe commands list.\")\n\n(defcustom cider-eldoc-max-num-sexps-to-skip 30\n  \"Max number of sexps to skip while searching the beginning of current sexp.\"\n  :type 'integer\n  :group 'cider\n  :package-version '(cider . \"0.10.1\"))\n\n(defvar-local cider-eldoc-last-symbol nil\n  \"The eldoc information for the last symbol we checked.\")\n\n(defcustom cider-eldoc-ns-function #'identity\n  \"A function that returns a ns string to be used by eldoc.\nTakes one argument, a namespace name.\nFor convenience, some functions are already provided for this purpose:\n`cider-abbreviate-ns', and `cider-last-ns-segment'.\"\n  :type '(choice (const :tag \"Full namespace\" identity)\n                 (const :tag \"Abbreviated namespace\" cider-abbreviate-ns)\n                 (const :tag \"Last name in namespace\" cider-last-ns-segment)\n                 (function :tag \"Custom function\"))\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(defcustom cider-eldoc-max-class-names-to-display 3\n  \"The maximum number of classes to display in an eldoc string.\nAn eldoc string for Java interop forms can have a number of classes prefixed to\nit, when the form belongs to more than 1 class.  When, not nil we only display\nthe names of first `cider-eldoc-max-class-names-to-display' classes and add\na \\\"& x more\\\" suffix. Otherwise, all the classes are displayed.\"\n  :type 'integer\n  :safe #'integerp\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(defcustom cider-eldoc-display-for-symbol-at-point t\n  \"When non-nil, display eldoc for symbol at point if available.\nSo in (map inc ...) when the cursor is over inc its eldoc would be\ndisplayed.  When nil, always display eldoc for first symbol of the sexp.\"\n  :type 'boolean\n  :safe #'booleanp\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(defcustom cider-eldoc-display-context-dependent-info nil\n  \"When non-nil, display context dependent info in the eldoc where possible.\nCIDER will try to add expected function arguments based on the current context,\nfor example for the datomic.api/q function where it will show the expected\ninputs of the query at point.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defun cider--eldoc-format-class-names (class-names)\n  \"Return a formatted CLASS-NAMES prefix string.\nCLASS-NAMES is a list of classes to which a Java interop form belongs.\nOnly keep the first `cider-eldoc-max-class-names-to-display' names, and\nadd a \\\"& x more\\\" suffix.  Return nil if the CLASS-NAMES list is empty or\nmapping `cider-eldoc-ns-function' on it returns an empty list.\"\n  (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names)))\n              (eldoc-class-names-length (length eldoc-class-names)))\n    (cond\n     ;; truncate class-names list and then format it\n     ((and cider-eldoc-max-class-names-to-display\n           (> eldoc-class-names-length cider-eldoc-max-class-names-to-display))\n      (format \"(%s & %s more)\"\n              (thread-first\n                eldoc-class-names\n                (seq-take cider-eldoc-max-class-names-to-display)\n                (string-join \" \")\n                (cider-propertize 'ns))\n              (- eldoc-class-names-length cider-eldoc-max-class-names-to-display)))\n\n     ;; format the whole list but add surrounding parentheses\n     ((> eldoc-class-names-length 1)\n      (format \"(%s)\"\n              (thread-first\n                eldoc-class-names\n                (string-join \" \")\n                (cider-propertize 'ns))))\n\n     ;; don't add the parentheses\n     (t (format \"%s\" (car eldoc-class-names))))))\n\n(defun cider-eldoc-format-thing (ns symbol thing type)\n  \"Format the eldoc subject defined by NS, SYMBOL, THING and TYPE.\nTHING represents the thing at point which triggered eldoc.  Normally NS and\nSYMBOL are used (they are derived from THING), but when empty we fallback to\nTHING (e.g. for Java methods).  Format it as a function, if FUNCTION-P\nis non-nil.  Else format it as a variable.\"\n  (if-let* ((method-name (if (and symbol (not (string= symbol \"\")))\n                             symbol\n                           thing))\n            (propertized-method-name (cider-propertize method-name type))\n            (ns-or-class (if (and ns (stringp ns))\n                             (funcall cider-eldoc-ns-function ns)\n                           (cider--eldoc-format-class-names ns))))\n      (format \"%s/%s\"\n              ;; we set font-lock properties of classes in `cider--eldoc-format-class-names'\n              ;; to avoid font locking the parentheses and \"& x more\"\n              ;; so we only propertize ns-or-class if not already done\n              (if (get-text-property 1 'face ns-or-class)\n                  ;; it is already propertized\n                  ns-or-class\n                (cider-propertize ns-or-class 'ns))\n              propertized-method-name)\n    ;; in case ns-or-class is nil\n    propertized-method-name))\n\n(defun cider-eldoc-format-sym-doc (var ns docstring)\n  \"Return the formatted eldoc string for VAR and DOCSTRING.\n\nConsider the value of `eldoc-echo-area-use-multiline-p' while formatting.\nIf the entire line cannot fit in the echo area, the var name may be\ntruncated or eliminated entirely from the output to make room for the\ndescription.\n\nTry to truncate the var with various strategies, so that the var and\nthe docstring can be displayed in the minibuffer without resizing the window.\nWe start with `cider-abbreviate-ns' and `cider-last-ns-segment'.\nNext, if the var is in current namespace, we remove NS from the eldoc string.\nOtherwise, only the docstring is returned.\"\n  (let* ((ea-multi eldoc-echo-area-use-multiline-p)\n         ;; Subtract 1 from window width since emacs will not write\n         ;; any chars to the last column, or in later versions, will\n         ;; cause a wraparound and resize of the echo area.\n         (ea-width (1- (window-width (minibuffer-window))))\n         (strip (- (+ (length var) (length docstring)) ea-width))\n         (newline (string-match-p \"\\n\" docstring))\n         ;; Truncated var can be ea-var long\n         ;; Subtract 2 to account for the : and / added when including\n         ;; the namespace prefixed form in eldoc string\n         (ea-var (- (- ea-width (length docstring)) 2)))\n    (cond\n     ((or (eq ea-multi t)\n          (and (<= strip 0) (null newline))\n          (and ea-multi (or (> (length docstring) ea-width) newline)))\n      (format \"%s: %s\" var docstring))\n\n     ;; Now we have to truncate either the docstring or the var\n     (newline (cider-eldoc-format-sym-doc var ns (substring docstring 0 newline)))\n\n     ;; Only return the truncated docstring\n     ((> (length docstring) ea-width)\n      (substring docstring 0 ea-width))\n\n     ;; Try to truncate the var with cider-abbreviate-ns\n     ((<= (length (cider-abbreviate-ns var)) ea-var)\n      (format \"%s: %s\" (cider-abbreviate-ns var) docstring))\n\n     ;; Try to truncate var with cider-last-ns-segment\n     ((<= (length (cider-last-ns-segment var)) ea-var)\n      (format \"%s: %s\" (cider-last-ns-segment var) docstring))\n\n     ;; If the var is in current namespace, we try to truncate the var by\n     ;; skipping the namespace from the returned eldoc string\n     ((and (string-equal ns (cider-current-ns))\n           (<= (- (length var) (length ns)) ea-var))\n      (format \"%s: %s\"\n              (replace-regexp-in-string (format \"%s/\" ns) \"\" var)\n              docstring))\n\n     ;; We couldn't fit the var and docstring in the available space,\n     ;; so we just display the docstring\n     (t docstring))))\n\n(defun cider-eldoc-format-variable (thing eldoc-info)\n  \"Return the formatted eldoc string for a variable.\n\nTHING is the variable name.  ELDOC-INFO is a p-list containing the eldoc\ninformation.\"\n  (let* ((ns (lax-plist-get eldoc-info \"ns\"))\n         (symbol (lax-plist-get eldoc-info \"symbol\"))\n         (docstring (lax-plist-get eldoc-info \"docstring\"))\n         (formatted-var (cider-eldoc-format-thing ns symbol thing 'var)))\n    (when docstring\n      (cider-eldoc-format-sym-doc formatted-var ns docstring))))\n\n(defun cider-eldoc-format-function (thing pos eldoc-info)\n  \"Return the formatted eldoc string for a function.\nTHING is the function name.  POS is the argument-index of the functions\narglists.  ELDOC-INFO is a p-list containing the eldoc information.\"\n  (let ((ns (lax-plist-get eldoc-info \"ns\"))\n        (symbol (lax-plist-get eldoc-info \"symbol\"))\n        (arglists (lax-plist-get eldoc-info \"arglists\")))\n    (format \"%s: %s\"\n            (cider-eldoc-format-thing ns symbol thing 'fn)\n            (cider-eldoc-format-arglist arglists pos))))\n\n(defun cider-highlight-args (arglist pos)\n  \"Format the the function ARGLIST for eldoc.\nPOS is the index of the currently highlighted argument.\"\n  (let* ((rest-pos (cider--find-rest-args-position arglist))\n         (i 0))\n    (mapconcat\n     (lambda (arg)\n       (let ((argstr (format \"%s\" arg)))\n         (if (string= arg \"&\")\n             argstr\n           (prog1\n               (if (or (= (1+ i) pos)\n                       (and rest-pos\n                            (> (1+ i) rest-pos)\n                            (> pos rest-pos)))\n                   (propertize argstr 'face\n                               'eldoc-highlight-function-argument)\n                 argstr)\n             (setq i (1+ i)))))) arglist \" \")))\n\n(defun cider--find-rest-args-position (arglist)\n  \"Find the position of & in the ARGLIST vector.\"\n  (seq-position arglist \"&\"))\n\n(defun cider-highlight-arglist (arglist pos)\n  \"Format the ARGLIST for eldoc.\nPOS is the index of the argument to highlight.\"\n  (concat \"[\" (cider-highlight-args arglist pos) \"]\"))\n\n(defun cider-eldoc-format-arglist (arglist pos)\n  \"Format all the ARGLIST for eldoc.\nPOS is the index of current argument.\"\n  (concat \"(\"\n          (mapconcat (lambda (args) (cider-highlight-arglist args pos))\n                     arglist\n                     \" \")\n          \")\"))\n\n(defun cider-eldoc-beginning-of-sexp ()\n  \"Move to the beginning of current sexp.\n\nReturn the number of nested sexp the point was over or after.  Return nil\nif the maximum number of sexps to skip is exceeded.\"\n  (let ((parse-sexp-ignore-comments t)\n        (num-skipped-sexps 0))\n    (condition-case _\n        (progn\n          ;; First account for the case the point is directly over a\n          ;; beginning of a nested sexp.\n          (condition-case _\n              (let ((p (point)))\n                (forward-sexp -1)\n                (forward-sexp 1)\n                (when (< (point) p)\n                  (setq num-skipped-sexps 1)))\n            (error))\n          (while\n              (let ((p (point)))\n                (clojure-backward-logical-sexp 1)\n                (when (< (point) p)\n                  (setq num-skipped-sexps\n                        (unless (and cider-eldoc-max-num-sexps-to-skip\n                                     (>= num-skipped-sexps\n                                         cider-eldoc-max-num-sexps-to-skip))\n                          ;; Without the above guard,\n                          ;; `cider-eldoc-beginning-of-sexp' could traverse the\n                          ;; whole buffer when the point is not within a\n                          ;; list. This behavior is problematic especially with\n                          ;; a buffer containing a large number of\n                          ;; non-expressions like a REPL buffer.\n                          (1+ num-skipped-sexps)))))))\n      (error))\n    num-skipped-sexps))\n\n(defun cider-eldoc-thing-type (eldoc-info)\n  \"Return the type of the ELDOC-INFO being displayed by eldoc.\nIt can be a function or var now.\"\n  (pcase (lax-plist-get eldoc-info \"type\")\n    (\"function\" 'fn)\n    (\"special-form\" 'special-form)\n    (\"macro\" 'macro)\n    (\"method\" 'method)\n    (\"variable\" 'var)))\n\n(defun cider-eldoc-info-at-point ()\n  \"Return eldoc info at point.\nFirst go to the beginning of the sexp and check if the eldoc is to be\nconsidered (i.e sexp is a method call) and not a map or vector literal.\nThen go back to the point and return its eldoc.\"\n  (save-excursion\n    (unless (cider-in-comment-p)\n      (let* ((current-point (point)))\n        (cider-eldoc-beginning-of-sexp)\n        (unless (member (or (char-before (point)) 0) '(?\\\" ?\\{ ?\\[))\n          (goto-char current-point)\n          (when-let* ((eldoc-info (cider-eldoc-info\n                                   (cider--eldoc-remove-dot (cider-symbol-at-point)))))\n            `(\"eldoc-info\" ,eldoc-info\n              \"thing\" ,(cider-symbol-at-point)\n              \"pos\" 0)))))))\n\n(defun cider-eldoc-info-at-sexp-beginning ()\n  \"Return eldoc info for first symbol in the sexp.\"\n  (save-excursion\n    (when-let* ((beginning-of-sexp (cider-eldoc-beginning-of-sexp))\n                ;; If we are at the beginning of function name, this will be -1\n                (argument-index (max 0 (1- beginning-of-sexp))))\n      (unless (or (memq (or (char-before (point)) 0)\n                        '(?\\\" ?\\{ ?\\[))\n                  (cider-in-comment-p))\n        (when-let* ((eldoc-info (cider-eldoc-info\n                                 (cider--eldoc-remove-dot (cider-symbol-at-point)))))\n          `(\"eldoc-info\" ,eldoc-info\n            \"thing\" ,(cider-symbol-at-point)\n            \"pos\" ,argument-index))))))\n\n(defun cider-eldoc-info-in-current-sexp ()\n  \"Return eldoc information from the sexp.\nIf `cider-eldoc-display-for-symbol-at-point' is non-nil and\nthe symbol at point has a valid eldoc available, return that.\nOtherwise return the eldoc of the first symbol of the sexp.\"\n  (or (when cider-eldoc-display-for-symbol-at-point\n        (cider-eldoc-info-at-point))\n      (cider-eldoc-info-at-sexp-beginning)))\n\n(defun cider-eldoc--convert-ns-keywords (thing)\n  \"Convert THING values that match ns macro keywords to function names.\"\n  (pcase thing\n    (\":import\" \"clojure.core/import\")\n    (\":refer-clojure\" \"clojure.core/refer-clojure\")\n    (\":use\" \"clojure.core/use\")\n    (\":refer\" \"clojure.core/refer\")\n    (_ thing)))\n\n(defun cider-eldoc-info (thing)\n  \"Return the info for THING.\nThis includes the arglist and ns and symbol name (if available).\"\n  (let ((thing (cider-eldoc--convert-ns-keywords thing)))\n    (when (and (cider-nrepl-op-supported-p \"eldoc\")\n               thing\n               ;; ignore blank things\n               (not (string-blank-p thing))\n               ;; ignore string literals\n               (not (string-prefix-p \"\\\"\" thing))\n               ;; ignore regular expressions\n               (not (string-prefix-p \"#\" thing))\n               ;; ignore chars\n               (not (string-prefix-p \"\\\\\" thing))\n               ;; ignore numbers\n               (not (string-match-p \"^[0-9]\" thing)))\n      ;; check if we can used the cached eldoc info\n      (cond\n       ;; handle keywords for map access\n       ((string-prefix-p \":\" thing) (list \"symbol\" thing\n                                          \"type\" \"function\"\n                                          \"arglists\" '((\"map\") (\"map\" \"not-found\"))))\n       ;; handle Classname. by displaying the eldoc for new\n       ((string-match-p \"^[A-Z].+\\\\.$\" thing) (list \"symbol\" thing\n                                                    \"type\" \"function\"\n                                                    \"arglists\" '((\"args*\"))))\n       ;; generic case\n       (t (if (equal thing (car cider-eldoc-last-symbol))\n              (cadr cider-eldoc-last-symbol)\n            (when-let* ((eldoc-info (cider-sync-request:eldoc thing)))\n              (let* ((arglists (nrepl-dict-get eldoc-info \"eldoc\"))\n                     (docstring (nrepl-dict-get eldoc-info \"docstring\"))\n                     (type (nrepl-dict-get eldoc-info \"type\"))\n                     (ns (nrepl-dict-get eldoc-info \"ns\"))\n                     (class (nrepl-dict-get eldoc-info \"class\"))\n                     (name (nrepl-dict-get eldoc-info \"name\"))\n                     (member (nrepl-dict-get eldoc-info \"member\"))\n                     (ns-or-class (if (and ns (not (string= ns \"\")))\n                                      ns\n                                    class))\n                     (name-or-member (if (and name (not (string= name \"\")))\n                                         name\n                                       (format \".%s\" member)))\n                     (eldoc-plist (list \"ns\" ns-or-class\n                                        \"symbol\" name-or-member\n                                        \"arglists\" arglists\n                                        \"docstring\" docstring\n                                        \"type\" type)))\n                ;; add context dependent args if requested by defcustom\n                ;; do not cache this eldoc info to avoid showing info\n                ;; of the previous context\n                (if cider-eldoc-display-context-dependent-info\n                    (cond\n                     ;; add inputs of datomic query\n                     ((and (equal ns-or-class \"datomic.api\")\n                           (equal name-or-member \"q\"))\n                      (let ((arglists (lax-plist-get eldoc-plist \"arglists\")))\n                        (lax-plist-put eldoc-plist \"arglists\"\n                                       (cider--eldoc-add-datomic-query-inputs-to-arglists arglists))))\n                     ;; if none of the clauses is successful, do cache the eldoc\n                     (t (setq cider-eldoc-last-symbol (list thing eldoc-plist))))\n                  ;; middleware eldoc lookups are expensive, so we\n                  ;; cache the last lookup.  This eliminates the need\n                  ;; for extra middleware requests within the same sexp.\n                  (setq cider-eldoc-last-symbol (list thing eldoc-plist)))\n                eldoc-plist))))))))\n\n(defun cider--eldoc-remove-dot (sym)\n  \"Remove the preceding \\\".\\\" from a namespace qualified SYM and return sym.\nOnly useful for interop forms.  Clojure forms would be returned unchanged.\"\n  (when sym (replace-regexp-in-string \"/\\\\.\" \"/\" sym)))\n\n(defun cider--eldoc-edn-file-p (file-name)\n  \"Check whether FILE-NAME is representing an EDN file.\"\n  (and file-name (equal (file-name-extension file-name) \"edn\")))\n\n(defun cider--eldoc-add-datomic-query-inputs-to-arglists (arglists)\n  \"Add the expected inputs of the datomic query to the ARGLISTS.\"\n  (if (cider-second-sexp-in-list)\n      (let* ((query (cider-second-sexp-in-list))\n             (query-inputs (nrepl-dict-get\n                            (cider-sync-request:eldoc-datomic-query query)\n                            \"inputs\")))\n        (if query-inputs\n            (thread-first\n              (thread-last arglists\n                           (car)\n                           (remove \"&\")\n                           (remove \"inputs\"))\n              (append (car query-inputs))\n              (list))\n          arglists))\n    arglists))\n\n(defun cider-eldoc (&rest _ignored)\n  \"Backend function for eldoc to show argument list in the echo area.\"\n  (when (and (cider-connected-p)\n             ;; don't clobber an error message in the minibuffer\n             (not (member last-command '(next-error previous-error)))\n             ;; don't try to provide eldoc in EDN buffers\n             (not (cider--eldoc-edn-file-p buffer-file-name)))\n    (let* ((sexp-eldoc-info (cider-eldoc-info-in-current-sexp))\n           (eldoc-info (lax-plist-get sexp-eldoc-info \"eldoc-info\"))\n           (pos (lax-plist-get sexp-eldoc-info \"pos\"))\n           (thing (lax-plist-get sexp-eldoc-info \"thing\")))\n      (when eldoc-info\n        (if (eq (cider-eldoc-thing-type eldoc-info) 'var)\n            (cider-eldoc-format-variable thing eldoc-info)\n          (cider-eldoc-format-function thing pos eldoc-info))))))\n\n(defun cider-eldoc-setup ()\n  \"Setup eldoc in the current buffer.\neldoc mode has to be enabled for this to have any effect.\"\n  ;; Emacs 28.1 changes the way eldoc is setup.\n  ;; There you can have multiple eldoc functions.\n  (if (boundp 'eldoc-documentation-functions)\n      (add-hook 'eldoc-documentation-functions #'cider-eldoc nil t)\n    (setq-local eldoc-documentation-function #'cider-eldoc))\n  (apply #'eldoc-add-command cider-extra-eldoc-commands))\n\n(provide 'cider-eldoc)\n\n;;; cider-eldoc.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-eval.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53318325,"end":53318362},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53318362},"to":{"change":3,"start":53247513,"end":53247513},"introduced_by":3}],"inode":{"change":3,"pos":53247513}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53247513},"to":{"change":3,"start":53247514,"end":53318324},"introduced_by":3}],"inode":{"change":3,"pos":53247513}},"content":[{"Del":";;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \n;;         Arne Brasseur \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; This file contains CIDER's interactive evaluation (compilation) functionality.\n;; Although Clojure doesn't really have the concept of evaluation (only\n;; compilation), we're using everywhere in the code the term evaluation for\n;; brevity (and to be in line with the naming employed by other similar modes).\n;;\n;; This files also contains all the logic related to displaying errors and\n;; evaluation warnings.\n;;\n;; Pretty much all of the commands here are meant to be used mostly from\n;; `cider-mode', but some of them might make sense in other contexts as well.\n\n;;; Code:\n\n(require 'ansi-color)\n(require 'cl-lib)\n(require 'compile)\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'clojure-mode)\n\n(require 'cider-client)\n(require 'cider-common)\n(require 'cider-jar)\n(require 'cider-overlays)\n(require 'cider-popup)\n(require 'cider-repl)\n(require 'cider-stacktrace)\n(require 'cider-util)\n\n(defconst cider-read-eval-buffer \"*cider-read-eval*\")\n(defconst cider-result-buffer \"*cider-result*\")\n\n(defcustom cider-show-error-buffer t\n  \"Control the popup behavior of cider stacktraces.\nThe following values are possible t or 'always, 'except-in-repl,\n'only-in-repl.  Any other value, including nil, will cause the stacktrace\nnot to be automatically shown.\n\nIrrespective of the value of this variable, the `cider-error-buffer' is\nalways generated in the background.  Use `cider-selector' to\nnavigate to this buffer.\"\n  :type '(choice (const :tag \"always\" t)\n                 (const except-in-repl)\n                 (const only-in-repl)\n                 (const :tag \"never\" nil))\n  :group 'cider)\n\n(defcustom cider-auto-jump-to-error t\n  \"Control the cursor jump behavior in compilation error buffer.\nWhen non-nil automatically jump to error location during interactive\ncompilation.  When set to 'errors-only, don't jump to warnings.\nWhen set to nil, don't jump at all.\"\n  :type '(choice (const :tag \"always\" t)\n                 (const errors-only)\n                 (const :tag \"never\" nil))\n  :group 'cider\n  :package-version '(cider . \"0.7.0\"))\n\n(defcustom cider-auto-select-error-buffer t\n  \"Controls whether to auto-select the error popup buffer.\"\n  :type 'boolean\n  :group 'cider)\n\n(defcustom cider-auto-track-ns-form-changes t\n  \"Controls whether to auto-evaluate a source buffer's ns form when changed.\nWhen non-nil CIDER will check for ns form changes before each eval command.\nWhen nil the users are expected to take care of the re-evaluating updated\nns forms manually themselves.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-auto-inspect-after-eval t\n  \"Controls whether to auto-update the inspector buffer after eval.\nOnly applies when the *cider-inspect* buffer is currently visible.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.25.0\"))\n\n(defcustom cider-save-file-on-load 'prompt\n  \"Controls whether to prompt to save the file when loading a buffer.\nIf nil, files are not saved.\nIf 'prompt, the user is prompted to save the file if it's been modified.\nIf t, save the file without confirmation.\"\n  :type '(choice (const prompt :tag \"Prompt to save the file if it's been modified\")\n                 (const nil :tag \"Don't save the file\")\n                 (const t :tag \"Save the file without confirmation\"))\n  :group 'cider\n  :package-version '(cider . \"0.6.0\"))\n\n(defcustom cider-file-loaded-hook nil\n  \"List of functions to call when a load file has completed.\"\n  :type 'hook\n  :group 'cider\n  :package-version '(cider . \"0.1.7\"))\n\n(defconst cider-output-buffer \"*cider-out*\")\n\n(defcustom cider-interactive-eval-output-destination 'repl-buffer\n  \"The destination for stdout and stderr produced from interactive evaluation.\"\n  :type '(choice (const output-buffer)\n                 (const repl-buffer))\n  :group 'cider\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-error-highlight-face\n  '((((supports :underline (:style wave)))\n     (:underline (:style wave :color \"red\") :inherit unspecified))\n    (t (:inherit font-lock-warning-face :underline t)))\n  \"Face used to highlight compilation errors in Clojure buffers.\"\n  :group 'cider)\n\n(defface cider-warning-highlight-face\n  '((((supports :underline (:style wave)))\n     (:underline (:style wave :color \"yellow\") :inherit unspecified))\n    (t (:inherit font-lock-warning-face :underline (:color \"yellow\"))))\n  \"Face used to highlight compilation warnings in Clojure buffers.\"\n  :group 'cider)\n\n(defcustom cider-comment-prefix \";; => \"\n  \"The prefix to insert before the first line of commented output.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.16.0\"))\n\n(defcustom cider-comment-continued-prefix \";;    \"\n  \"The prefix to use on the second and subsequent lines of commented output.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.16.0\"))\n\n(defcustom cider-comment-postfix \"\"\n  \"The postfix to be appended after the final line of commented output.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.16.0\"))\n\n(defcustom cider-eval-register ?e\n  \"The text register assigned to the most recent evaluation result.\nWhen non-nil, the return value of all CIDER eval commands are\nautomatically written into this register.\"\n  :type '(choice character\n                 (const nil))\n  :group 'cider\n  :package-version '(cider . \"1.4.0\"))\n\n\f\n;;; Utilities\n\n(defun cider--clear-compilation-highlights ()\n  \"Remove compilation highlights.\"\n  (remove-overlays (point-min) (point-max) 'cider-note-p t))\n\n(defun cider-clear-compilation-highlights (&optional arg)\n  \"Remove compilation highlights.\nWhen invoked with a prefix ARG the command doesn't prompt for confirmation.\"\n  (interactive \"P\")\n  (when (or arg (y-or-n-p \"Are you sure you want to clear the compilation highlights? \"))\n    (cider--clear-compilation-highlights)))\n\n(defun cider--quit-error-window ()\n  \"Buries the `cider-error-buffer' and quits its containing window.\"\n  (when-let* ((error-win (get-buffer-window cider-error-buffer)))\n    (save-excursion\n      (quit-window nil error-win))))\n\n\f\n;;; Sideloader\n;;\n;; nREPL includes sideloader middleware which provides a Java classloader that\n;; is able to dynamically load classes and resources at runtime by interacting\n;; with the nREPL client (as opposed to using the classpath of the JVM hosting\n;; nREPL server).\n;;\n;; This performs a similar functionality as the load-file\n;; operation, where we can load Clojure namespaces (as source files) or Java\n;; classes (as bytecode) by simply requiring or importing them.\n;;\n;; See https://nrepl.org/nrepl/design/middleware.html#sideloading\n\n(defcustom cider-sideloader-path nil\n  \"List of directories and jar files to scan for sideloader resources.\nWhen not set the cider-nrepl jar will be added automatically when upgrading\nan nREPL connection.\"\n  :type 'list\n  :group 'cider\n  :package-version '(cider . \"1.2.0\"))\n\n(defcustom cider-dynload-cider-nrepl-version nil\n  \"Version of the cider-nrepl jar used for dynamically upgrading a connection.\nDefaults to `cider-required-middleware-version'.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"1.2.0\"))\n\n(defun cider-read-bytes (path)\n  \"Read binary data from PATH.\nReturn the binary data as unibyte string.\"\n  ;; based on f-read-bytes\n  (with-temp-buffer\n    (set-buffer-multibyte nil)\n    (setq buffer-file-coding-system 'binary)\n    (insert-file-contents-literally path nil)\n    (buffer-substring-no-properties (point-min) (point-max))))\n\n(defun cider-retrieve-resource (dirs name)\n  \"Find a resource NAME in a list DIRS of directories or jar files.\nSimilar to a classpath lookup.  Returns the file contents as a string.\"\n  (seq-some\n   (lambda (path)\n     (cond\n      ((file-directory-p path)\n       (let ((expanded (expand-file-name name path)))\n         (when (file-exists-p expanded)\n           (cider-read-bytes expanded))))\n      ((and (file-exists-p path) (string-suffix-p \".jar\" path))\n       (cider-jar-retrieve-resource path name))))\n   dirs))\n\n(defun cider-provide-file (file)\n  \"Provide FILE in a format suitable for sideloading.\"\n  (let ((contents (cider-retrieve-resource cider-sideloader-path file)))\n    (if contents\n        (base64-encode-string contents 'no-line-breaks)\n      ;; if we can't find the file we should return an empty string\n      (base64-encode-string \"\"))))\n\n(defun cider-sideloader-lookup-handler ()\n  \"Make a sideloader-lookup handler.\"\n  (lambda (response)\n    (nrepl-dbind-response response (id status type name)\n      (if status\n          (when (member \"sideloader-lookup\" status)\n            (cider-request:sideloader-provide id type name))))))\n\n(defun cider-add-middleware-handler (continue)\n  \"Make a add-middleware handler.\nCONTINUE is an optional continuation function.\"\n  (lambda (response)\n    (nrepl-dbind-response response (status unresolved-middleware) ;; id middleware\n      (when unresolved-middleware\n        (seq-do\n         (lambda (mw)\n           (cider-repl-emit-interactive-stderr\n            (concat \"WARNING: middleware \" mw \" was not found or failed to load.\\n\")))\n         unresolved-middleware))\n      (when (and status (member \"done\" status) continue)\n        (funcall continue)))))\n\n(defun cider-request:sideloader-start (&optional connection tooling)\n  \"Perform the nREPL \\\"sideloader-start\\\" op.\nIf CONNECTION is nil, use `cider-current-repl'.\nIf TOOLING is truthy then the operation is performed over the tooling\nsession, rather than the regular session.\"\n  (cider-ensure-op-supported \"sideloader-start\")\n  (cider-nrepl-send-request `(\"op\" \"sideloader-start\")\n                            (cider-sideloader-lookup-handler)\n                            connection\n                            tooling))\n\n(defun cider-request:sideloader-provide (id type file &optional connection)\n  \"Perform the nREPL \\\"sideloader-provide\\\" op for ID, TYPE and FILE.\nIf CONNECTION is nil, use `cider-current-repl'.\"\n  (cider-nrepl-send-request `(\"id\" ,id\n                              \"op\" \"sideloader-provide\"\n                              \"type\" ,type\n                              \"name\" ,file\n                              \"content\" ,(cider-provide-file file))\n                            (cider-sideloader-lookup-handler)\n                            connection))\n\n(defun cider-sideloader-start (&optional connection)\n  \"Start nREPL's sideloader.\nIf CONNECTION is nil, use `cider-current-repl'.\"\n  (interactive)\n  (message \"Starting nREPL's sideloader\")\n  (cider-request:sideloader-start connection)\n  (cider-request:sideloader-start connection 'tooling))\n\n(defvar cider-nrepl-middlewares\n  '(\"cider.nrepl/wrap-apropos\"\n    \"cider.nrepl/wrap-classpath\"\n    \"cider.nrepl/wrap-clojuredocs\"\n    \"cider.nrepl/wrap-complete\"\n    \"cider.nrepl/wrap-content-type\"\n    \"cider.nrepl/wrap-debug\"\n    \"cider.nrepl/wrap-enlighten\"\n    \"cider.nrepl/wrap-format\"\n    \"cider.nrepl/wrap-info\"\n    \"cider.nrepl/wrap-inspect\"\n    \"cider.nrepl/wrap-macroexpand\"\n    \"cider.nrepl/wrap-ns\"\n    \"cider.nrepl/wrap-out\"\n    \"cider.nrepl/wrap-slurp\"\n    \"cider.nrepl/wrap-profile\"\n    \"cider.nrepl/wrap-refresh\"\n    \"cider.nrepl/wrap-resource\"\n    \"cider.nrepl/wrap-spec\"\n    \"cider.nrepl/wrap-stacktrace\"\n    \"cider.nrepl/wrap-test\"\n    \"cider.nrepl/wrap-trace\"\n    \"cider.nrepl/wrap-tracker\"\n    \"cider.nrepl/wrap-undef\"\n    \"cider.nrepl/wrap-version\"\n    \"cider.nrepl/wrap-xref\"))\n\n(defun cider-request:add-middleware (middlewares\n                                     &optional connection tooling continue)\n  \"Use the nREPL dynamic loader to add MIDDLEWARES to the nREPL session.\n\n- If CONNECTION is nil, use `cider-current-repl'.\n- If TOOLING it truthy, use the tooling session instead of the main session.\n- CONTINUE is an optional continuation function, which will be called when the\nadd-middleware op has finished successfully.\"\n  (cider-nrepl-send-request `(\"op\" \"add-middleware\"\n                              \"middleware\" ,middlewares)\n                            (cider-add-middleware-handler continue)\n                            connection\n                            tooling))\n\n(defun cider-add-cider-nrepl-middlewares (&optional connection)\n  \"Use dynamic loading to add the cider-nrepl middlewares to nREPL.\nIf CONNECTION is nil, use `cider-current-repl'.\"\n  (cider-request:add-middleware\n   cider-nrepl-middlewares connection nil\n   (lambda ()\n     ;; When the main session is done adding middleware, then do the tooling\n     ;; session. At this point all the namespaces have been sideloaded so this\n     ;; is faster, we don't want these to race to sideload resources.\n     (cider-request:add-middleware\n      cider-nrepl-middlewares connection 'tooling\n      (lambda ()\n        ;; Ask nREPL again what its capabilities are, so we know which new\n        ;; operations are supported.\n        (nrepl--init-capabilities (or connection (cider-current-repl))))))))\n\n(defvar cider-required-middleware-version)\n(defun cider-upgrade-nrepl-connection (&optional connection)\n  \"Sideload cider-nrepl middleware.\nIf CONNECTION is nil, use `cider-current-repl'.\"\n  (interactive)\n  (when (not cider-sideloader-path)\n    (setq cider-sideloader-path (list (cider-jar-find-or-fetch\n                                       \"cider\" \"cider-nrepl\"\n                                       (or cider-dynload-cider-nrepl-version\n                                           cider-required-middleware-version)))))\n  (cider-sideloader-start connection)\n  (cider-add-cider-nrepl-middlewares connection))\n\n\f\n;;; Dealing with compilation (evaluation) errors and warnings\n(defun cider-find-property (property &optional backward)\n  \"Find the next text region which has the specified PROPERTY.\nIf BACKWARD is t, then search backward.\nReturns the position at which PROPERTY was found, or nil if not found.\"\n  (let ((p (if backward\n               (previous-single-char-property-change (point) property)\n             (next-single-char-property-change (point) property))))\n    (when (and (not (= p (point-min))) (not (= p (point-max))))\n      p)))\n\n(defun cider-jump-to-compilation-error (&optional _arg _reset)\n  \"Jump to the line causing the current compilation error.\n_ARG and _RESET are ignored, as there is only ever one compilation error.\nThey exist for compatibility with `next-error'.\"\n  (interactive)\n  (cl-labels ((goto-next-note-boundary\n               ()\n               (let ((p (or (cider-find-property 'cider-note-p)\n                            (cider-find-property 'cider-note-p t))))\n                 (when p\n                   (goto-char p)\n                   (message \"%s\" (get-char-property p 'cider-note))))))\n    ;; if we're already on a compilation error, first jump to the end of\n    ;; it, so that we find the next error.\n    (when (get-char-property (point) 'cider-note-p)\n      (goto-next-note-boundary))\n    (goto-next-note-boundary)))\n\n(defun cider--show-error-buffer-p ()\n  \"Return non-nil if the error buffer must be shown on error.\nTakes into account both the value of `cider-show-error-buffer' and the\ncurrently selected buffer.\"\n  (let* ((selected-buffer (window-buffer (selected-window)))\n         (replp (with-current-buffer selected-buffer (derived-mode-p 'cider-repl-mode))))\n    (memq cider-show-error-buffer\n          (if replp\n              '(t always only-in-repl)\n            '(t always except-in-repl)))))\n\n(defun cider-new-error-buffer (&optional mode error-types)\n  \"Return an empty error buffer using MODE.\n\nWhen deciding whether to display the buffer, takes into account not only\nthe value of `cider-show-error-buffer' and the currently selected buffer\nbut also the ERROR-TYPES of the error, which is checked against the\n`cider-stacktrace-suppressed-errors' set.\n\nWhen deciding whether to select the buffer, takes into account the value of\n`cider-auto-select-error-buffer'.\"\n  (if (and (cider--show-error-buffer-p)\n           (not (cider-stacktrace-some-suppressed-errors-p error-types)))\n      (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer mode 'ancillary)\n    (cider-make-popup-buffer cider-error-buffer mode 'ancillary)))\n\n(defun cider-emit-into-color-buffer (buffer value)\n  \"Emit into color BUFFER the provided VALUE.\"\n  (with-current-buffer buffer\n    (let ((inhibit-read-only t)\n          (buffer-undo-list t))\n      (goto-char (point-max))\n      (insert (format \"%s\" value))\n      (ansi-color-apply-on-region (point-min) (point-max)))\n    (goto-char (point-min))))\n\n(defun cider--handle-err-eval-response (response)\n  \"Render eval RESPONSE into a new error buffer.\n\nUses the value of the `out' slot in RESPONSE.\"\n  (nrepl-dbind-response response (out)\n    (when out\n      (let ((error-buffer (cider-new-error-buffer)))\n        (cider-emit-into-color-buffer error-buffer out)\n        (with-current-buffer error-buffer\n          (compilation-minor-mode +1))))))\n\n(defun cider-default-err-eval-handler ()\n  \"Display the last exception without middleware support.\"\n  (cider--handle-err-eval-response\n   (cider-nrepl-sync-request:eval\n    \"(clojure.stacktrace/print-cause-trace *e)\")))\n\n(defun cider--render-stacktrace-causes (causes &optional error-types)\n  \"If CAUSES is non-nil, render its contents into a new error buffer.\nOptional argument ERROR-TYPES contains a list which should determine the\nop/situation that originated this error.\"\n  (when causes\n    (let ((error-buffer (cider-new-error-buffer #'cider-stacktrace-mode error-types)))\n      (cider-stacktrace-render error-buffer (reverse causes) error-types))))\n\n(defun cider--handle-stacktrace-response (response causes)\n  \"Handle stacktrace op RESPONSE, aggregating the result into CAUSES.\nIf RESPONSE contains a cause, cons it onto CAUSES and return that.  If\nRESPONSE is the final message (i.e. it contains a status), render CAUSES\ninto a new error buffer.\"\n  (nrepl-dbind-response response (class status)\n    (cond (class (cons response causes))\n          (status (cider--render-stacktrace-causes causes)))))\n\n(defun cider-default-err-op-handler ()\n  \"Display the last exception, with middleware support.\"\n  ;; Causes are returned as a series of messages, which we aggregate in `causes'\n  (let (causes)\n    (cider-nrepl-send-request\n     (thread-last\n       (map-merge 'list\n                  '((\"op\" \"stacktrace\"))\n                  (cider--nrepl-print-request-map fill-column))\n       (seq-mapcat #'identity))\n     (lambda (response)\n       ;; While the return value of `cider--handle-stacktrace-response' is not\n       ;; meaningful for the last message, we do not need the value of `causes'\n       ;; after it has been handled, so it's fine to set it unconditionally here\n       (setq causes (cider--handle-stacktrace-response response causes))))))\n\n(defun cider-default-err-handler ()\n  \"This function determines how the error buffer is shown.\nIt delegates the actual error content to the eval or op handler.\"\n  (if (cider-nrepl-op-supported-p \"stacktrace\")\n      (cider-default-err-op-handler)\n    (cider-default-err-eval-handler)))\n\n;; The format of the error messages emitted by Clojure's compiler changed in\n;; Clojure 1.10.  That's why we're trying to match error messages to both the\n;; old and the new format, by utilizing a combination of two different regular\n;; expressions.\n\n(defconst cider-clojure-1.10-error `(sequence\n                                     \"Syntax error \"\n                                     (minimal-match (zero-or-more anything))\n                                     \"compiling \"\n                                     (minimal-match (zero-or-more anything))\n                                     \"at (\"\n                                     (group-n 2 (minimal-match (zero-or-more anything)))\n                                     \":\"\n                                     (group-n 3 (one-or-more digit))\n                                     (optional \":\" (group-n 4 (one-or-more digit)))\n                                     \").\"))\n\n(defconst cider-clojure-1.9-error `(sequence\n                                    (zero-or-more anything)\n                                    \", compiling:(\"\n                                    (group-n 2 (minimal-match (zero-or-more anything)))\n                                    \":\"\n                                    (group-n 3 (one-or-more digit))\n                                    (optional \":\" (group-n 4 (one-or-more digit)))\n                                    \")\"))\n\n(defconst cider-clojure-warning `(sequence\n                                  (minimal-match (zero-or-more anything))\n                                  (group-n 1 \"warning\")\n                                  \", \"\n                                  (group-n 2 (minimal-match (zero-or-more anything)))\n                                  \":\"\n                                  (group-n 3 (one-or-more digit))\n                                  (optional \":\" (group-n 4 (one-or-more digit)))\n                                  \" - \"))\n\n\n(defconst cider-clojure-compilation-regexp\n  (eval\n   `(rx bol (or ,cider-clojure-1.9-error\n                ,cider-clojure-warning\n                ,cider-clojure-1.10-error))\n   t))\n\n\n(defvar cider-compilation-regexp\n  (list cider-clojure-compilation-regexp  2 3 4 '(1))\n  \"Specifications for matching errors and warnings in Clojure stacktraces.\nSee `compilation-error-regexp-alist' for help on their format.\")\n\n(add-to-list 'compilation-error-regexp-alist-alist\n             (cons 'cider cider-compilation-regexp))\n(add-to-list 'compilation-error-regexp-alist 'cider)\n\n(defun cider-extract-error-info (regexp message)\n  \"Extract error information with REGEXP against MESSAGE.\"\n  (let ((file (nth 1 regexp))\n        (line (nth 2 regexp))\n        (col (nth 3 regexp))\n        (type (nth 4 regexp))\n        (pat (car regexp)))\n    (when (string-match pat message)\n      ;; special processing for type (1.2) style\n      (setq type (if (consp type)\n                     (or (and (car type) (match-end (car type)) 1)\n                         (and (cdr type) (match-end (cdr type)) 0)\n                         2)))\n      (list\n       (when file\n         (let ((val (match-string-no-properties file message)))\n           (unless (string= val \"NO_SOURCE_PATH\") val)))\n       (when line (string-to-number (match-string-no-properties line message)))\n       (when col\n         (let ((val (match-string-no-properties col message)))\n           (when (and val (not (string-blank-p val))) (string-to-number val))))\n       (aref [cider-warning-highlight-face\n              cider-warning-highlight-face\n              cider-error-highlight-face]\n             (or type 2))\n       message))))\n\n(defun cider--goto-expression-start ()\n  \"Go to the beginning a list, vector, map or set outside of a string.\nWe do so by starting and the current position and proceeding backwards\nuntil we find a delimiters that's not inside a string.\"\n  (if (and (looking-back \"[])}]\" (line-beginning-position))\n           (null (nth 3 (syntax-ppss))))\n      (backward-sexp)\n    (while (or (not (looking-at-p \"[({[]\"))\n               (nth 3 (syntax-ppss)))\n      (backward-char))))\n\n(defun cider--find-last-error-location (message)\n  \"Return the location (begin end buffer) from the Clojure error MESSAGE.\nIf location could not be found, return nil.\"\n  (save-excursion\n    (let ((info (cider-extract-error-info cider-compilation-regexp message)))\n      (when info\n        (let ((file (nth 0 info))\n              (line (nth 1 info))\n              (col (nth 2 info)))\n          (unless (or (not (stringp file))\n                      (cider--tooling-file-p file))\n            (when-let* ((buffer (cider-find-file file)))\n              (with-current-buffer buffer\n                (save-excursion\n                  (save-restriction\n                    (widen)\n                    (goto-char (point-min))\n                    (forward-line (1- line))\n                    (move-to-column (or col 0))\n                    (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation))\n                                        (point)))\n                          (end (progn (if col (forward-list) (move-end-of-line nil))\n                                      (point))))\n                      (list begin end buffer))))))))))))\n\n(defun cider-handle-compilation-errors (message eval-buffer)\n  \"Highlight and jump to compilation error extracted from MESSAGE.\nEVAL-BUFFER is the buffer that was current during user's interactive\nevaluation command.  Honor `cider-auto-jump-to-error'.\"\n  (when-let* ((loc (cider--find-last-error-location message))\n              (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc)))\n              (info (cider-extract-error-info cider-compilation-regexp message)))\n    (let* ((face (nth 3 info))\n           (note (nth 4 info))\n           (auto-jump (if (eq cider-auto-jump-to-error 'errors-only)\n                          (not (or (eq face 'cider-warning-highlight-face)\n                                   (string-match-p \"warning\" note)))\n                        cider-auto-jump-to-error)))\n      (overlay-put overlay 'cider-note-p t)\n      (overlay-put overlay 'font-lock-face face)\n      (overlay-put overlay 'cider-note note)\n      (overlay-put overlay 'help-echo note)\n      (overlay-put overlay 'modification-hooks\n                   (list (lambda (o &rest _args) (delete-overlay o))))\n      (when auto-jump\n        (with-current-buffer eval-buffer\n          (push-mark)\n          ;; At this stage selected window commonly is *cider-error* and we need to\n          ;; re-select the original user window. If eval-buffer is not\n          ;; visible it was probably covered as a result of a small screen or user\n          ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In\n          ;; that case we don't jump at all in order to avoid covering *cider-error*\n          ;; buffer.\n          (when-let* ((win (get-buffer-window eval-buffer)))\n            (with-selected-window win\n              (cider-jump-to (nth 2 loc) (car loc)))))))))\n\n\f\n;;; Interactive evaluation handlers\n(defun cider-insert-eval-handler (&optional buffer)\n  \"Make an nREPL evaluation handler for the BUFFER.\nThe handler simply inserts the result value in BUFFER.\"\n  (let ((eval-buffer (current-buffer))\n        (res \"\"))\n    (nrepl-make-response-handler (or buffer eval-buffer)\n                                 (lambda (_buffer value)\n                                   (with-current-buffer buffer\n                                     (insert value))\n                                   (when cider-eval-register\n                                     (setq res (concat res value))))\n                                 (lambda (_buffer out)\n                                   (cider-repl-emit-interactive-stdout out))\n                                 (lambda (_buffer err)\n                                   (cider-handle-compilation-errors err eval-buffer))\n                                 (lambda (_buffer)\n                                   (when cider-eval-register\n                                     (set-register cider-eval-register res))))))\n\n(defun cider--emit-interactive-eval-output (output repl-emit-function)\n  \"Emit output resulting from interactive code evaluation.\nThe OUTPUT can be sent to either a dedicated output buffer or the current\nREPL buffer.  This is controlled by `cider-interactive-eval-output-destination'.\nREPL-EMIT-FUNCTION emits the OUTPUT.\"\n  (pcase cider-interactive-eval-output-destination\n    (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer)\n                                             (cider-popup-buffer cider-output-buffer t))))\n                      (cider-emit-into-popup-buffer output-buffer output)\n                      (pop-to-buffer output-buffer)))\n    (`repl-buffer (funcall repl-emit-function output))\n    (_ (error \"Unsupported value %s for `cider-interactive-eval-output-destination'\"\n              cider-interactive-eval-output-destination))))\n\n(defun cider-emit-interactive-eval-output (output)\n  \"Emit OUTPUT resulting from interactive code evaluation.\nThe output can be send to either a dedicated output buffer or the current\nREPL buffer.  This is controlled via\n`cider-interactive-eval-output-destination'.\"\n  (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout))\n\n(defun cider-emit-interactive-eval-err-output (output)\n  \"Emit err OUTPUT resulting from interactive code evaluation.\nThe output can be send to either a dedicated output buffer or the current\nREPL buffer.  This is controlled via\n`cider-interactive-eval-output-destination'.\"\n  (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr))\n\n(defun cider--make-fringe-overlays-for-region (beg end)\n  \"Place eval indicators on all sexps between BEG and END.\"\n  (with-current-buffer (if (markerp end)\n                           (marker-buffer end)\n                         (current-buffer))\n    (save-excursion\n      (goto-char beg)\n      (remove-overlays beg end 'category 'cider-fringe-indicator)\n      (condition-case nil\n          (while (progn (clojure-forward-logical-sexp)\n                        (and (<= (point) end)\n                             (not (eobp))))\n            (cider--make-fringe-overlay (point)))\n        (scan-error nil)))))\n\n(declare-function cider-inspect-last-result \"cider-inspector\")\n(defun cider-interactive-eval-handler (&optional buffer place)\n  \"Make an interactive eval handler for BUFFER.\nPLACE is used to display the evaluation result.\nIf non-nil, it can be the position where the evaluated sexp ends,\nor it can be a list with (START END) of the evaluated region.\nUpdate the cider-inspector buffer with the evaluation result\nwhen `cider-auto-inspect-after-eval' is non-nil.\"\n\n  (let* ((eval-buffer (current-buffer))\n         (beg (car-safe place))\n         (end (or (car-safe (cdr-safe place)) place))\n         (beg (when beg (copy-marker beg)))\n         (end (when end (copy-marker end)))\n         (fringed nil)\n         (res \"\"))\n    (nrepl-make-response-handler (or buffer eval-buffer)\n                                 (lambda (_buffer value)\n                                   (setq res (concat res value))\n                                   (cider--display-interactive-eval-result res end))\n                                 (lambda (_buffer out)\n                                   (cider-emit-interactive-eval-output out))\n                                 (lambda (_buffer err)\n                                   (cider-emit-interactive-eval-err-output err)\n                                   (unless cider-show-error-buffer\n                                     ;; Display errors as temporary overlays\n                                     (let ((cider-result-use-clojure-font-lock nil))\n                                       (cider--display-interactive-eval-result\n                                        err end 'cider-error-overlay-face)))\n                                   (cider-handle-compilation-errors err eval-buffer))\n                                 (lambda (buffer)\n                                   (if beg\n                                       (unless fringed\n                                         (cider--make-fringe-overlays-for-region beg end)\n                                         (setq fringed t))\n                                     (cider--make-fringe-overlay end))\n                                   (when (and cider-auto-inspect-after-eval\n                                              (boundp 'cider-inspector-buffer)\n                                              (windowp (get-buffer-window cider-inspector-buffer 'visible)))\n                                     (cider-inspect-last-result)\n                                     (select-window (get-buffer-window buffer)))\n                                   (when cider-eval-register\n                                     (set-register cider-eval-register res))))))\n\n\n(defun cider-load-file-handler (&optional buffer done-handler)\n  \"Make a load file handler for BUFFER.\nOptional argument DONE-HANDLER lambda will be run once load is complete.\"\n  (let ((eval-buffer (current-buffer))\n        (res \"\"))\n    (nrepl-make-response-handler (or buffer eval-buffer)\n                                 (lambda (buffer value)\n                                   (cider--display-interactive-eval-result value)\n                                   (when cider-eval-register\n                                     (setq res (concat res value)))\n                                   (when (buffer-live-p buffer)\n                                     (with-current-buffer buffer\n                                       (cider--make-fringe-overlays-for-region (point-min) (point-max))\n                                       (run-hooks 'cider-file-loaded-hook))))\n                                 (lambda (_buffer value)\n                                   (cider-emit-interactive-eval-output value))\n                                 (lambda (_buffer err)\n                                   (cider-emit-interactive-eval-err-output err)\n                                   (cider-handle-compilation-errors err eval-buffer))\n                                 (lambda (buffer)\n                                   (when cider-eval-register\n                                     (set-register cider-eval-register res))\n                                   (when done-handler\n                                     (funcall done-handler buffer)))\n                                 (lambda ()\n                                   (funcall nrepl-err-handler)))))\n\n(defun cider-eval-print-handler (&optional buffer)\n  \"Make a handler for evaluating and printing result in BUFFER.\"\n  ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons.\n  ;; See https://github.com/clojure-emacs/cider/pull/3162\n  (nrepl-make-response-handler (or buffer (current-buffer))\n                               (lambda (buffer value)\n                                 (with-current-buffer buffer\n                                   (insert\n                                    (if (derived-mode-p 'cider-clojure-interaction-mode)\n                                        (format \"\\n%s\\n\" value)\n                                      value))))\n                               (lambda (_buffer out)\n                                 (cider-emit-interactive-eval-output out))\n                               (lambda (_buffer err)\n                                 (cider-emit-interactive-eval-err-output err))\n                               ()))\n\n(defun cider-eval-print-with-comment-handler (buffer location comment-prefix)\n  \"Make a handler for evaluating and printing commented results in BUFFER.\nLOCATION is the location marker at which to insert.  COMMENT-PREFIX is the\ncomment prefix to use.\"\n  (let ((res \"\"))\n    (nrepl-make-response-handler buffer\n                                 (lambda (_buffer value)\n                                   (setq res (concat res value)))\n                                 (lambda (_buffer out)\n                                   (cider-emit-interactive-eval-output out))\n                                 (lambda (_buffer err)\n                                   (cider-emit-interactive-eval-err-output err))\n                                 (lambda (buffer)\n                                   (with-current-buffer buffer\n                                     (save-excursion\n                                       (goto-char (marker-position location))\n                                       (insert (concat comment-prefix\n                                                       res \"\\n\"))))\n                                   (when cider-eval-register\n                                     (set-register cider-eval-register res))))))\n\n(defun cider-maybe-insert-multiline-comment (result comment-prefix continued-prefix comment-postfix)\n  \"Insert eval RESULT at current location if RESULT is not empty.\nRESULT will be preceded by COMMENT-PREFIX.\nCONTINUED-PREFIX is inserted for each additional line of output.\nCOMMENT-POSTFIX is inserted after final text output.\"\n  (unless (string= result \"\")\n    (clojure-indent-line)\n    (let ((lines (split-string result \"[\\n]+\" t))\n          (beg (point))\n          (col (current-indentation)))\n      ;; only the first line gets the normal comment-prefix\n      (insert (concat comment-prefix (pop lines)))\n      (dolist (elem lines)\n        (insert (concat \"\\n\" continued-prefix elem)))\n      (indent-rigidly beg (point) col)\n      (unless (string= comment-postfix \"\")\n        (insert comment-postfix)))))\n\n(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix)\n  \"Make a handler for evaluating and inserting results in BUFFER.\nThe inserted text is pretty-printed and region will be commented.\nLOCATION is the location marker at which to insert.\nCOMMENT-PREFIX is the comment prefix for the first line of output.\nCONTINUED-PREFIX is the comment prefix to use for the remaining lines.\nCOMMENT-POSTFIX is the text to output after the last line.\"\n  (let ((res \"\"))\n    (nrepl-make-response-handler\n     buffer\n     (lambda (_buffer value)\n       (setq res (concat res value)))\n     nil\n     (lambda (_buffer err)\n       (setq res (concat res err)))\n     (lambda (buffer)\n       (with-current-buffer buffer\n         (save-excursion\n           (goto-char (marker-position location))\n           ;; edge case: defun at eob\n           (unless (bolp) (insert \"\\n\"))\n           (cider-maybe-insert-multiline-comment res comment-prefix continued-prefix comment-postfix)))\n       (when cider-eval-register\n         (set-register cider-eval-register res)))\n     nil\n     nil\n     (lambda (_buffer warning)\n       (setq res (concat res warning))))))\n\n(defun cider-popup-eval-handler (&optional buffer)\n  \"Make a handler for printing evaluation results in popup BUFFER.\nThis is used by pretty-printing commands.\"\n  ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons.\n  ;; See https://github.com/clojure-emacs/cider/pull/3162\n  (nrepl-make-response-handler\n   (or buffer (current-buffer))\n   (lambda (buffer value)\n     (cider-emit-into-popup-buffer buffer (ansi-color-apply value) nil t))\n   (lambda (_buffer out)\n     (cider-emit-interactive-eval-output out))\n   (lambda (_buffer err)\n     (cider-emit-interactive-eval-err-output err))\n   nil\n   nil\n   nil\n   (lambda (buffer warning)\n     (cider-emit-into-popup-buffer buffer warning 'font-lock-warning-face t))))\n\n\f\n;;; Interactive valuation commands\n\n(defvar cider-to-nrepl-filename-function\n  (with-no-warnings\n    (lambda (path)\n      (let ((path* (if (eq system-type 'cygwin)\n                       (cygwin-convert-file-name-to-windows path)\n                     path)))\n        (or (cider--translate-path-to-nrepl path*) path*))))\n  \"Function to translate Emacs filenames to nREPL namestrings.\")\n\n(defun cider--prep-interactive-eval (form connection)\n  \"Prepare the environment for an interactive eval of FORM in CONNECTION.\nEnsure the current ns declaration has been evaluated (so that the ns\ncontaining FORM exists).  Cache ns-form in the current buffer unless FORM is\nns declaration itself.  Clear any compilation highlights and kill the error\nwindow.\"\n  (cider--clear-compilation-highlights)\n  (cider--quit-error-window)\n  (let ((cur-ns-form (cider-ns-form)))\n    (when (and cur-ns-form\n               (not (cider-ns-form-p form))\n               (cider-repl--ns-form-changed-p cur-ns-form connection))\n      (when cider-auto-track-ns-form-changes\n        ;; The first interactive eval on a file can load a lot of libs. This can\n        ;; easily lead to more than 10 sec.\n        (let ((nrepl-sync-request-timeout 30))\n          ;; TODO: check for evaluation errors\n          (cider-nrepl-sync-request:eval cur-ns-form connection)))\n      ;; cache at the end, in case of errors\n      (cider-repl--cache-ns-form cur-ns-form connection))))\n\n(defvar-local cider-interactive-eval-override nil\n  \"Function to call instead of `cider-interactive-eval'.\")\n\n(defun cider-interactive-eval (form &optional callback bounds additional-params)\n  \"Evaluate FORM and dispatch the response to CALLBACK.\nIf the code to be evaluated comes from a buffer, it is preferred to use a\nnil FORM, and specify the code via the BOUNDS argument instead.\n\nThis function is the main entry point in CIDER's interactive evaluation\nAPI.  Most other interactive eval functions should rely on this function.\nIf CALLBACK is nil use `cider-interactive-eval-handler'.\nBOUNDS, if non-nil, is a list of two numbers marking the start and end\npositions of FORM in its buffer.\nADDITIONAL-PARAMS is a map to be merged into the request message.\n\nIf `cider-interactive-eval-override' is a function, call it with the same\narguments and only proceed with evaluation if it returns nil.\"\n  (let ((form  (or form (apply #'buffer-substring-no-properties bounds)))\n        (start (car-safe bounds))\n        (end   (car-safe (cdr-safe bounds))))\n    (when (and start end)\n      ;; NOTE: don't use `remove-overlays' as it splits and leaves behind\n      ;; partial overlays, leading to duplicate eval results in some situations.\n      (dolist (ov (overlays-in start end))\n        (when (eq (overlay-get ov 'cider-temporary) t)\n          (delete-overlay ov))))\n    (unless (and cider-interactive-eval-override\n                 (functionp cider-interactive-eval-override)\n                 (funcall cider-interactive-eval-override form callback bounds))\n      (cider-map-repls :auto\n        (lambda (connection)\n          (cider--prep-interactive-eval form connection)\n          (cider-nrepl-request:eval\n           form\n           (or callback (cider-interactive-eval-handler nil bounds))\n           ;; always eval ns forms in the user namespace\n           ;; otherwise trying to eval ns form for the first time will produce an error\n           (if (cider-ns-form-p form) \"user\" (cider-current-ns))\n           (when start (line-number-at-pos start))\n           (when start (cider-column-number-at-pos start))\n           (seq-mapcat #'identity additional-params)\n           connection))))))\n\n(defun cider-eval-region (start end)\n  \"Evaluate the region between START and END.\"\n  (interactive \"r\")\n  (cider-interactive-eval nil\n                          nil\n                          (list start end)\n                          (cider--nrepl-pr-request-map)))\n\n(defun cider-eval-last-sexp (&optional output-to-current-buffer)\n  \"Evaluate the expression preceding point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current\nbuffer.\"\n  (interactive \"P\")\n  (cider-interactive-eval nil\n                          (when output-to-current-buffer (cider-eval-print-handler))\n                          (cider-last-sexp 'bounds)\n                          (cider--nrepl-pr-request-map)))\n\n(defun cider-eval-last-sexp-and-replace ()\n  \"Evaluate the expression preceding point and replace it with its result.\"\n  (interactive)\n  (let ((last-sexp (cider-last-sexp)))\n    ;; we have to be sure the evaluation won't result in an error\n    (cider-nrepl-sync-request:eval last-sexp)\n    ;; seems like the sexp is valid, so we can safely kill it\n    (let ((opoint (point)))\n      (clojure-backward-logical-sexp)\n      (kill-region (point) opoint))\n    (cider-interactive-eval last-sexp\n                            (cider-eval-print-handler)\n                            nil\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider-eval-list-at-point (&optional output-to-current-buffer)\n  \"Evaluate the list (eg.  a function call, surrounded by parens) around point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer.\"\n  (interactive \"P\")\n  (save-excursion\n    (goto-char (cadr (cider-list-at-point 'bounds)))\n    (cider-eval-last-sexp output-to-current-buffer)))\n\n(defun cider-eval-sexp-at-point (&optional output-to-current-buffer)\n  \"Evaluate the expression around point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer.\"\n  (interactive \"P\")\n  (save-excursion\n    (goto-char (cadr (cider-sexp-at-point 'bounds)))\n    (cider-eval-last-sexp output-to-current-buffer)))\n\n(defun cider-tap-last-sexp (&optional output-to-current-buffer)\n  \"Evaluate and tap the expression preceding point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current\nbuffer.\"\n  (interactive \"P\")\n  (let ((tapped-form (concat \"(clojure.core/doto \" (cider-last-sexp) \" (clojure.core/tap>))\")))\n    (cider-interactive-eval tapped-form\n                            (when output-to-current-buffer (cider-eval-print-handler))\n                            nil\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider-tap-sexp-at-point (&optional output-to-current-buffer)\n  \"Evaluate and tap the expression around point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer.\"\n  (interactive \"P\")\n  (save-excursion\n    (goto-char (cadr (cider-sexp-at-point 'bounds)))\n    (cider-tap-last-sexp output-to-current-buffer)))\n\n(defvar-local cider-previous-eval-context nil\n  \"The previous evaluation context if any.\nThat's set by commands like `cider-eval-last-sexp-in-context'.\")\n\n\n(defun cider--guess-eval-context ()\n  \"Return context for `cider--eval-in-context'.\nThis is done by extracting all parent let bindings.\"\n  (save-excursion\n    (let ((res \"\"))\n      (condition-case nil\n          (while t\n            (backward-up-list)\n            (when (looking-at (rx \"(\" (or \"when-let\" \"if-let\" \"let\") (opt \"*\")\n                                  symbol-end (* space)\n                                  (group \"[\"))) ;; binding vector\n              (let ((beg (match-end 1))\n                    (end (save-excursion\n                           (goto-char (match-beginning 1))\n                           (forward-sexp 1)\n                           (1- (point)))))\n                (setq res (concat (buffer-substring-no-properties beg end) \", \" res)))))\n        (scan-error res)))))\n\n(defun cider--eval-in-context (bounds &optional guess)\n  \"Evaluate code at BOUNDS in user-provided evaluation context.\nWhen GUESS is non-nil, attempt to extract the context from parent let-bindings.\"\n  (let* ((code (string-trim-right\n                (buffer-substring-no-properties (car bounds) (cadr bounds))))\n         (eval-context\n          (minibuffer-with-setup-hook (if guess #'beginning-of-buffer #'ignore)\n            (read-string \"Evaluation context (let-style): \"\n                         (if guess (cider--guess-eval-context)\n                           cider-previous-eval-context))))\n         (code (concat \"(let [\" eval-context \"]\\n  \" code \")\")))\n    (setq-local cider-previous-eval-context eval-context)\n    (cider-interactive-eval code\n                            nil\n                            bounds\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider-eval-last-sexp-in-context (guess)\n  \"Evaluate the preceding sexp in user-supplied context.\nThe context is just a let binding vector (without the brackets).\nThe context is remembered between command invocations.\n\nWhen GUESS is non-nil, or called interactively with \\\\[universal-argument],\nattempt to extract the context from parent let-bindings.\"\n  (interactive \"P\")\n  (cider--eval-in-context (cider-last-sexp 'bounds) guess))\n\n(defun cider-eval-sexp-at-point-in-context (guess)\n  \"Evaluate the sexp around point in user-supplied context.\n\nThe context is just a let binding vector (without the brackets).\nThe context is remembered between command invocations.\n\nWhen GUESS is non-nil, or called interactively with \\\\[universal-argument],\nattempt to extract the context from parent let-bindings.\"\n  (interactive \"P\")\n  (cider--eval-in-context (cider-sexp-at-point 'bounds) guess))\n\n(defun cider-eval-defun-to-comment (&optional insert-before)\n  \"Evaluate the \\\"top-level\\\" form and insert result as comment.\n\nThe formatting of the comment is defined in `cider-comment-prefix'\nwhich, by default, is \\\";; => \\\" and can be customized.\n\nWith the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards.\"\n  (interactive \"P\")\n  (let* ((bounds (cider-defun-at-point 'bounds))\n         (insertion-point (nth (if insert-before 0 1) bounds)))\n    (cider-interactive-eval nil\n                            (cider-eval-print-with-comment-handler\n                             (current-buffer)\n                             (set-marker (make-marker) insertion-point)\n                             cider-comment-prefix)\n                            bounds\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider-pprint-form-to-comment (form-fn insert-before)\n  \"Evaluate the form selected by FORM-FN and insert result as comment.\nFORM-FN can be either `cider-last-sexp' or `cider-defun-at-point'.\n\nThe formatting of the comment is controlled via three options:\n    `cider-comment-prefix'           \\\";; => \\\"\n    `cider-comment-continued-prefix' \\\";;    \\\"\n    `cider-comment-postfix'          \\\"\\\"\n\nso that with customization you can optionally wrap the output\nin the reader macro \\\"#_( .. )\\\", or \\\"(comment ... )\\\", or any\nother desired formatting.\n\nIf INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards.\"\n  (let* ((bounds (funcall form-fn 'bounds))\n         (insertion-point (nth (if insert-before 0 1) bounds))\n         ;; when insert-before, we need a newline after the output to\n         ;; avoid commenting the first line of the form\n         (comment-postfix (concat cider-comment-postfix\n                                  (if insert-before \"\\n\" \"\"))))\n    (cider-interactive-eval nil\n                            (cider-eval-pprint-with-multiline-comment-handler\n                             (current-buffer)\n                             (set-marker (make-marker) insertion-point)\n                             cider-comment-prefix\n                             cider-comment-continued-prefix\n                             comment-postfix)\n                            bounds\n                            (cider--nrepl-print-request-map fill-column))))\n\n(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before)\n  \"Evaluate the last sexp and insert result as comment.\n\nThe formatting of the comment is controlled via three options:\n    `cider-comment-prefix'           \\\";; => \\\"\n    `cider-comment-continued-prefix' \\\";;    \\\"\n    `cider-comment-postfix'          \\\"\\\"\n\nso that with customization you can optionally wrap the output\nin the reader macro \\\"#_( .. )\\\", or \\\"(comment ... )\\\", or any\nother desired formatting.\n\nIf INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards.\"\n  (interactive \"P\")\n  (cider-pprint-form-to-comment 'cider-last-sexp insert-before))\n\n(defun cider-pprint-eval-defun-to-comment (&optional insert-before)\n  \"Evaluate the \\\"top-level\\\" form and insert result as comment.\n\nThe formatting of the comment is controlled via three options:\n    `cider-comment-prefix'           \\\";; => \\\"\n    `cider-comment-continued-prefix' \\\";;    \\\"\n    `cider-comment-postfix'          \\\"\\\"\n\nso that with customization you can optionally wrap the output\nin the reader macro \\\"#_( .. )\\\", or \\\"(comment ... )\\\", or any\nother desired formatting.\n\nIf INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards.\"\n  (interactive \"P\")\n  (cider-pprint-form-to-comment 'cider-defun-at-point insert-before))\n\n(declare-function cider-switch-to-repl-buffer \"cider-mode\")\n\n(defun cider-eval-last-sexp-to-repl (&optional prefix)\n  \"Evaluate the expression preceding point and insert its result in the REPL.\nIf invoked with a PREFIX argument, switch to the REPL buffer.\"\n  (interactive \"P\")\n  (cider-interactive-eval nil\n                          (cider-insert-eval-handler (cider-current-repl))\n                          (cider-last-sexp 'bounds)\n                          (cider--nrepl-pr-request-map))\n  (when prefix\n    (cider-switch-to-repl-buffer)))\n\n(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix)\n  \"Evaluate expr before point and insert its pretty-printed result in the REPL.\nIf invoked with a PREFIX argument, switch to the REPL buffer.\"\n  (interactive \"P\")\n  (cider-interactive-eval nil\n                          (cider-insert-eval-handler (cider-current-repl))\n                          (cider-last-sexp 'bounds)\n                          (cider--nrepl-print-request-map fill-column))\n  (when prefix\n    (cider-switch-to-repl-buffer)))\n\n(defun cider-eval-print-last-sexp (&optional pretty-print)\n  \"Evaluate the expression preceding point.\nPrint its value into the current buffer.\nWith an optional PRETTY-PRINT prefix it pretty-prints the result.\"\n  (interactive \"P\")\n  (cider-interactive-eval nil\n                          (cider-eval-print-handler)\n                          (cider-last-sexp 'bounds)\n                          (if pretty-print\n                              (cider--nrepl-print-request-map fill-column)\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider--pprint-eval-form (form)\n  \"Pretty print FORM in popup buffer.\"\n  (let* ((buffer (current-buffer))\n         (result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary))\n         (handler (cider-popup-eval-handler result-buffer)))\n    (with-current-buffer buffer\n      (cider-interactive-eval (when (stringp form) form)\n                              handler\n                              (when (consp form) form)\n                              (cider--nrepl-print-request-map fill-column)))))\n\n(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer)\n  \"Evaluate the sexp preceding point and pprint its value.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current\nbuffer, else display in a popup buffer.\"\n  (interactive \"P\")\n  (if output-to-current-buffer\n      (cider-pprint-eval-last-sexp-to-comment)\n    (cider--pprint-eval-form (cider-last-sexp 'bounds))))\n\n(defun cider--prompt-and-insert-inline-dbg ()\n  \"Insert a #dbg button at the current sexp.\"\n  (save-excursion\n    (let ((beg))\n      (skip-chars-forward \"\\r\\n[:blank:]\")\n      (unless (looking-at-p \"(\")\n        (ignore-errors (backward-up-list)))\n      (setq beg (point))\n      (let* ((cond (cider-read-from-minibuffer \"Condition for debugging (leave empty for \\\"always\\\"): \"))\n             (button (propertize (concat \"#dbg\"\n                                         (unless (equal cond \"\")\n                                           (format \" ^{:break/when %s}\" cond)))\n                                 'font-lock-face 'cider-fragile-button-face)))\n        (when (> (current-column) 30)\n          (insert \"\\n\")\n          (indent-according-to-mode))\n        (insert button)\n        (when (> (current-column) 40)\n          (insert \"\\n\")\n          (indent-according-to-mode)))\n      (make-button beg (point)\n                   'help-echo \"Breakpoint. Reevaluate this form to remove it.\"\n                   :type 'cider-fragile))))\n\n(defun cider-eval-defun-at-point (&optional debug-it)\n  \"Evaluate the current toplevel form, and print result in the minibuffer.\nWith DEBUG-IT prefix argument, also debug the entire form as with the\ncommand `cider-debug-defun-at-point'.\"\n  (interactive \"P\")\n  (let ((inline-debug (eq 16 (car-safe debug-it))))\n    (when debug-it\n      (when (derived-mode-p 'clojurescript-mode)\n        (when (y-or-n-p (concat \"The debugger doesn't support ClojureScript yet, and we need help with that.\"\n                                \"  \\nWould you like to read the Feature Request?\"))\n          (browse-url \"https://github.com/clojure-emacs/cider/issues/1416\"))\n        (user-error \"The debugger does not support ClojureScript\"))\n      (when inline-debug\n        (cider--prompt-and-insert-inline-dbg)))\n    (cider-interactive-eval (when (and debug-it (not inline-debug))\n                              (concat \"#dbg\\n\" (cider-defun-at-point)))\n                            nil\n                            (cider-defun-at-point 'bounds)\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider--insert-closing-delimiters (code)\n  \"Closes all open parenthesized or bracketed expressions of CODE.\"\n  (with-temp-buffer\n    (insert code)\n    (goto-char (point-max))\n    (let ((matching-delimiter nil))\n      (while (ignore-errors\n               (save-excursion\n                 (backward-up-list 1)\n                 (setq matching-delimiter (cdr (syntax-after (point)))))\n               t)\n        (insert-char matching-delimiter)))\n    (buffer-string)))\n\n(defun cider-eval-defun-up-to-point (&optional output-to-current-buffer)\n  \"Evaluate the current toplevel form up to point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current\nbuffer.  It constructs an expression to eval in the following manner:\n\n- It find the code between the point and the start of the toplevel expression;\n- It balances this bit of code by closing all open expressions;\n- It evaluates the resulting code using `cider-interactive-eval'.\"\n  (interactive \"P\")\n  (let* ((beg-of-defun (save-excursion (beginning-of-defun) (point)))\n         (code (buffer-substring-no-properties beg-of-defun (point)))\n         (code (cider--insert-closing-delimiters code)))\n    (cider-interactive-eval code\n                            (when output-to-current-buffer\n                              (cider-eval-print-handler))\n                            (list beg-of-defun (point))\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider--matching-delimiter (delimiter)\n  \"Get the matching (opening/closing) delimiter for DELIMITER.\"\n  (pcase delimiter\n    (?\\( ?\\))\n    (?\\[ ?\\])\n    (?\\{ ?\\})\n    (?\\) ?\\()\n    (?\\] ?\\[)\n    (?\\} ?\\{)))\n\n(defun cider-eval-sexp-up-to-point (&optional  output-to-current-buffer)\n  \"Evaluate the current sexp form up to point.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current\nbuffer.  It constructs an expression to eval in the following manner:\n\n- It finds the code between the point and the start of the sexp expression;\n- It balances this bit of code by closing the expression;\n- It evaluates the resulting code using `cider-interactive-eval'.\"\n  (interactive \"P\")\n  (let* ((beg-of-sexp (save-excursion (up-list) (backward-list) (point)))\n         (beg-delimiter (save-excursion (up-list) (backward-list) (char-after)))\n         (beg-set?  (save-excursion (up-list) (backward-list) (char-before)))\n         (code (buffer-substring-no-properties beg-of-sexp (point)))\n         (code (if (= beg-set? ?#) (concat (list beg-set?) code) code))\n         (code (concat code (list (cider--matching-delimiter beg-delimiter)))))\n    (cider-interactive-eval code\n                            (when output-to-current-buffer\n                              (cider-eval-print-handler))\n                            (list beg-of-sexp (point))\n                            (cider--nrepl-pr-request-map))))\n\n(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer)\n  \"Evaluate the \\\"top-level\\\" form at point and pprint its value.\nIf invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current\nbuffer, else display in a popup buffer.\"\n  (interactive \"P\")\n  (if output-to-current-buffer\n      (cider-pprint-eval-defun-to-comment)\n    (cider--pprint-eval-form (cider-defun-at-point 'bounds))))\n\n(defun cider-eval-ns-form (&optional undef-all)\n  \"Evaluate the current buffer's namespace form.\nWhen UNDEF-ALL is non-nil, unmap all symbols and aliases first.\"\n  (interactive \"P\")\n  (when-let ((ns (clojure-find-ns)))\n    (save-excursion\n      (goto-char (match-beginning 0))\n      (when undef-all\n        (cider-undef-all ns))\n      (cider-eval-defun-at-point))))\n\n(defun cider-read-and-eval (&optional value)\n  \"Read a sexp from the minibuffer and output its result to the echo area.\nIf VALUE is non-nil, it is inserted into the minibuffer as initial input.\"\n  (interactive)\n  (let* ((form (cider-read-from-minibuffer \"Clojure Eval: \" value))\n         (override cider-interactive-eval-override)\n         (ns-form (if (cider-ns-form-p form) \"\" (format \"(ns %s)\" (cider-current-ns)))))\n    (with-current-buffer (get-buffer-create cider-read-eval-buffer)\n      (erase-buffer)\n      (clojure-mode)\n      (unless (string= \"\" ns-form)\n        (insert ns-form \"\\n\\n\"))\n      (insert form)\n      (let ((cider-interactive-eval-override override))\n        (cider-interactive-eval form\n                                nil\n                                nil\n                                (cider--nrepl-pr-request-map))))))\n\n(defun cider-read-and-eval-defun-at-point ()\n  \"Insert the toplevel form at point in the minibuffer and output its result.\nThe point is placed next to the function name in the minibuffer to allow\npassing arguments.\"\n  (interactive)\n  (let* ((fn-name (cadr (split-string (cider-defun-at-point))))\n         (form (format \"(%s)\" fn-name)))\n    (cider-read-and-eval (cons form (length form)))))\n\n(defun cider-kill-last-result ()\n  \"Save the last evaluated result into the kill ring.\"\n  (interactive)\n  (kill-new\n   (nrepl-dict-get (cider-nrepl-sync-request:eval \"*1\") \"value\")))\n\n(defun cider-undef ()\n  \"Undefine a symbol from the current ns.\"\n  (interactive)\n  (cider-ensure-op-supported \"undef\")\n  (cider-read-symbol-name\n   \"Undefine symbol: \"\n   (lambda (sym)\n     (cider-nrepl-send-request\n      `(\"op\" \"undef\"\n        \"ns\" ,(cider-current-ns)\n        \"sym\" ,sym)\n      (cider-interactive-eval-handler (current-buffer))))))\n\n(defun cider-undef-all (&optional ns)\n  \"Undefine all symbols and aliases from the namespace NS.\"\n  (interactive)\n  (cider-ensure-op-supported \"undef-all\")\n  (cider-nrepl-send-sync-request\n   `(\"op\" \"undef-all\"\n     \"ns\" ,(or ns (cider-current-ns)))))\n\n;; Eval keymaps\n(defvar cider-eval-pprint-commands-map\n  (let ((map (define-prefix-command 'cider-eval-pprint-commands-map)))\n    ;; single key bindings defined last for display in menu\n    (define-key map (kbd \"e\") #'cider-pprint-eval-last-sexp)\n    (define-key map (kbd \"d\") #'cider-pprint-eval-defun-at-point)\n    (define-key map (kbd \"c e\") #'cider-pprint-eval-last-sexp-to-comment)\n    (define-key map (kbd \"c d\") #'cider-pprint-eval-defun-to-comment)\n\n    ;; duplicates with C- for convenience\n    (define-key map (kbd \"C-e\") #'cider-pprint-eval-last-sexp)\n    (define-key map (kbd \"C-d\") #'cider-pprint-eval-defun-at-point)\n    (define-key map (kbd \"C-c e\") #'cider-pprint-eval-last-sexp-to-comment)\n    (define-key map (kbd \"C-c C-e\") #'cider-pprint-eval-last-sexp-to-comment)\n    (define-key map (kbd \"C-c d\") #'cider-pprint-eval-defun-to-comment)\n    (define-key map (kbd \"C-c C-d\") #'cider-pprint-eval-defun-to-comment)\n    map))\n\n(defvar cider-eval-commands-map\n  (let ((map (define-prefix-command 'cider-eval-commands-map)))\n    ;; single key bindings defined last for display in menu\n    (define-key map (kbd \"w\") #'cider-eval-last-sexp-and-replace)\n    (define-key map (kbd \"r\") #'cider-eval-region)\n    (define-key map (kbd \"n\") #'cider-eval-ns-form)\n    (define-key map (kbd \"d\") #'cider-eval-defun-at-point)\n    (define-key map (kbd \"e\") #'cider-eval-last-sexp)\n    (define-key map (kbd \"q\") #'cider-tap-last-sexp)\n    (define-key map (kbd \"l\") #'cider-eval-list-at-point)\n    (define-key map (kbd \"v\") #'cider-eval-sexp-at-point)\n    (define-key map (kbd \"t\") #'cider-tap-sexp-at-point)\n    (define-key map (kbd \"o\") #'cider-eval-sexp-up-to-point)\n    (define-key map (kbd \".\") #'cider-read-and-eval-defun-at-point)\n    (define-key map (kbd \"z\") #'cider-eval-defun-up-to-point)\n    (define-key map (kbd \"c\") #'cider-eval-last-sexp-in-context)\n    (define-key map (kbd \"b\") #'cider-eval-sexp-at-point-in-context)\n    (define-key map (kbd \"k\") #'cider-kill-last-result)\n    (define-key map (kbd \"f\") 'cider-eval-pprint-commands-map)\n\n    ;; duplicates with C- for convenience\n    (define-key map (kbd \"C-w\") #'cider-eval-last-sexp-and-replace)\n    (define-key map (kbd \"C-r\") #'cider-eval-region)\n    (define-key map (kbd \"C-n\") #'cider-eval-ns-form)\n    (define-key map (kbd \"C-d\") #'cider-eval-defun-at-point)\n    (define-key map (kbd \"C-e\") #'cider-eval-last-sexp)\n    (define-key map (kbd \"C-q\") #'cider-tap-last-sexp)\n    (define-key map (kbd \"C-l\") #'cider-eval-list-at-point)\n    (define-key map (kbd \"C-v\") #'cider-eval-sexp-at-point)\n    (define-key map (kbd \"C-t\") #'cider-tap-sexp-at-point)\n    (define-key map (kbd \"C-o\") #'cider-eval-sexp-up-to-point)\n    (define-key map (kbd \"C-.\") #'cider-read-and-eval-defun-at-point)\n    (define-key map (kbd \"C-z\") #'cider-eval-defun-up-to-point)\n    (define-key map (kbd \"C-c\") #'cider-eval-last-sexp-in-context)\n    (define-key map (kbd \"C-b\") #'cider-eval-sexp-at-point-in-context)\n    (define-key map (kbd \"C-k\") #'cider-kill-last-result)\n    (define-key map (kbd \"C-f\") 'cider-eval-pprint-commands-map)\n    map))\n\n(defun cider--file-string (file)\n  \"Read the contents of a FILE and return as a string.\"\n  (with-current-buffer (find-file-noselect file)\n    (save-restriction\n      (widen)\n      (substring-no-properties (buffer-string)))))\n\n(defun cider-load-buffer (&optional buffer callback undef-all)\n  \"Load (eval) BUFFER's file in nREPL.\nIf no buffer is provided the command acts on the current buffer.  If the\nbuffer is for a cljc file, and both a Clojure and ClojureScript REPL exists\nfor the project, it is evaluated in both REPLs.\nOptional argument CALLBACK will override the default ‘cider-load-file-handler’.\nWhen UNDEF-ALL is non-nil or called with \\\\[universal-argument], removes\nall ns aliases and var mappings from the namespace before reloading it.\"\n  (interactive (list (current-buffer) nil (equal current-prefix-arg '(4))))\n  (setq buffer (or buffer (current-buffer)))\n  ;; When cider-load-buffer or cider-load-file are called in programs the\n  ;; current context might not match the buffer's context. We use the caller\n  ;; context instead of the buffer's context because that's the common use\n  ;; case. For the other use case just let-bind the default-directory.\n  (let ((orig-default-directory default-directory))\n    (with-current-buffer buffer\n      (check-parens)\n      (let ((default-directory orig-default-directory))\n        (unless buffer-file-name\n          (user-error \"Buffer `%s' is not associated with a file\" (current-buffer)))\n        (when (and cider-save-file-on-load\n                   (buffer-modified-p)\n                   (or (eq cider-save-file-on-load t)\n                       (y-or-n-p (format \"Save file %s? \" buffer-file-name))))\n          (save-buffer))\n        (remove-overlays nil nil 'cider-temporary t)\n        (when undef-all\n          (cider-undef-all (cider-current-ns)))\n        (cider--clear-compilation-highlights)\n        (cider--quit-error-window)\n        (let ((filename (buffer-file-name buffer))\n              (ns-form  (cider-ns-form)))\n          (cider-map-repls :auto\n            (lambda (repl)\n              (when ns-form\n                (cider-repl--cache-ns-form ns-form repl))\n              (cider-request:load-file (cider--file-string filename)\n                                       (funcall cider-to-nrepl-filename-function\n                                                (cider--server-filename filename))\n                                       (file-name-nondirectory filename)\n                                       repl\n                                       callback)))\n          (message \"Loading %s...\" filename))))))\n\n(defun cider-load-file (filename &optional undef-all)\n  \"Load (eval) the Clojure file FILENAME in nREPL.\nIf the file is a cljc file, and both a Clojure and ClojureScript REPL\nexists for the project, it is evaluated in both REPLs.  The heavy lifting\nis done by `cider-load-buffer'.\nWhen UNDEF-ALL is non-nil or called with \\\\[universal-argument], removes\nall ns aliases and var mappings from the namespace before reloading it.\"\n  (interactive (list\n                (read-file-name \"Load file: \" nil nil nil\n                                (when (buffer-file-name)\n                                  (file-name-nondirectory\n                                   (buffer-file-name))))\n                (equal current-prefix-arg '(4))))\n  (if-let* ((buffer (find-buffer-visiting filename)))\n      (cider-load-buffer buffer nil undef-all)\n    (cider-load-buffer (find-file-noselect filename) nil undef-all)))\n\n(defun cider-load-all-files (directory undef-all)\n  \"Load all files in DIRECTORY (recursively).\nUseful when the running nREPL on remote host.\nWhen UNDEF-ALL is non-nil or called with \\\\[universal-argument], removes\nall ns aliases and var mappings from the namespaces being reloaded\"\n  (interactive \"DLoad files beneath directory: \\nP\")\n  (mapcar (lambda (file) (cider-load-file file undef-all))\n          (directory-files-recursively directory \"\\\\.clj[cs]?$\")))\n\n(defalias 'cider-eval-file #'cider-load-file\n  \"A convenience alias as some people are confused by the load-* names.\")\n\n(defalias 'cider-eval-all-files #'cider-load-all-files\n  \"A convenience alias as some people are confused by the load-* names.\")\n\n(defalias 'cider-eval-buffer #'cider-load-buffer\n  \"A convenience alias as some people are confused by the load-* names.\")\n\n(defun cider-load-all-project-ns ()\n  \"Load all namespaces in the current project.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"ns-load-all\")\n  (when (y-or-n-p \"Are you sure you want to load all namespaces in the project? \")\n    (message \"Loading all project namespaces...\")\n    (let ((loaded-ns-count (length (cider-sync-request:ns-load-all))))\n      (message \"Loaded %d namespaces\" loaded-ns-count))))\n\n(provide 'cider-eval)\n\n;;; cider-eval.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-find.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53247474,"end":53247511},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53247511},"to":{"change":3,"start":53234956,"end":53234956},"introduced_by":3}],"inode":{"change":3,"pos":53234956}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53234956},"to":{"change":3,"start":53234957,"end":53247473},"introduced_by":3}],"inode":{"change":3,"pos":53234956}},"content":[{"Del":";;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \n;;         Artur Malabarba \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; A bunch of commands for finding resources and definitions.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-common)\n(require 'cider-resolve)\n\n(require 'thingatpt)\n\n(defun cider--find-var-other-window (var &optional line)\n  \"Find the definition of VAR, optionally at a specific LINE.\n\nDisplay the results in a different window.\"\n  (if-let* ((info (cider-var-info var)))\n      (progn\n        (if line (setq info (nrepl-dict-put info \"line\" line)))\n        (cider--jump-to-loc-from-info info t))\n    (user-error \"Symbol `%s' not resolved\" var)))\n\n(defun cider--find-var (var &optional line)\n  \"Find the definition of VAR, optionally at a specific LINE.\"\n  (if-let* ((info (cider-var-info var)))\n      (progn\n        (if line (setq info (nrepl-dict-put info \"line\" line)))\n        (cider--jump-to-loc-from-info info))\n    (user-error \"Symbol `%s' not resolved\" var)))\n\n;;;###autoload\n(defun cider-find-var (&optional arg var line)\n  \"Find definition for VAR at LINE.\nPrompt according to prefix ARG and `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix of `-` or a double prefix argument causes\nthe results to be displayed in a different window.  The default value is\nthing at point.\"\n  (interactive \"P\")\n  (if var\n      (cider--find-var var line)\n    (funcall (cider-prompt-for-symbol-function arg)\n             \"Symbol\"\n             (if (cider--open-other-window-p arg)\n                 #'cider--find-var-other-window\n               #'cider--find-var))))\n\n;;;###autoload\n(defun cider-find-dwim-at-mouse (event)\n  \"Find and display variable or resource at mouse EVENT.\"\n  (interactive \"e\")\n  (if-let* ((symbol-file (save-excursion\n                           (mouse-set-point event)\n                           (cider-symbol-at-point 'look-back))))\n      (cider-find-dwim symbol-file)\n    (user-error \"No variable or resource here\")))\n\n(defun cider--find-dwim (symbol-file callback &optional other-window)\n  \"Find the SYMBOL-FILE at point.\nCALLBACK upon failure to invoke prompt if not prompted previously.\nShow results in a different window if OTHER-WINDOW is true.\"\n  (if-let* ((info (cider-var-info symbol-file)))\n      (cider--jump-to-loc-from-info info other-window)\n    (progn\n      (cider-ensure-op-supported \"resource\")\n      (if-let* ((resource (cider-sync-request:resource symbol-file))\n                (buffer (cider-find-file resource)))\n          (cider-jump-to buffer 0 other-window)\n        (if (cider--prompt-for-symbol-p current-prefix-arg)\n            (error \"Resource or var %s not resolved\" symbol-file)\n          (let ((current-prefix-arg (if current-prefix-arg nil '(4))))\n            (call-interactively callback)))))))\n\n(defun cider--find-dwim-interactive (prompt)\n  \"Get interactive arguments for jump-to functions using PROMPT as needed.\"\n  (if (cider--prompt-for-symbol-p current-prefix-arg)\n      (list\n       (cider-read-from-minibuffer prompt (thing-at-point 'filename)))\n    (list (or (thing-at-point 'filename) \"\"))))  ; No prompt.\n\n(defun cider-find-dwim-other-window (symbol-file)\n  \"Jump to SYMBOL-FILE at point, place results in other window.\"\n  (interactive (cider--find-dwim-interactive \"Jump to: \"))\n  (cider--find-dwim symbol-file 'cider-find-dwim-other-window t))\n\n;;;###autoload\n(defun cider-find-dwim (symbol-file)\n  \"Find and display the SYMBOL-FILE at point.\nSYMBOL-FILE could be a var or a resource.  If thing at point is empty then\nshow Dired on project.  If var is not found, try to jump to resource of the\nsame name.  When called interactively, a prompt is given according to the\nvariable `cider-prompt-for-symbol'.  A single or double prefix argument\ninverts the meaning.  A prefix of `-' or a double prefix argument causes\nthe results to be displayed in a different window.  A default value of thing\nat point is given when prompted.\"\n  (interactive (cider--find-dwim-interactive \"Jump to: \"))\n  (cider--find-dwim symbol-file `cider-find-dwim\n                    (cider--open-other-window-p current-prefix-arg)))\n\n;;;###autoload\n(defun cider-find-resource (path)\n  \"Find the resource at PATH.\nPrompt for input as indicated by the variable `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix argument of `-` or a double prefix\nargument causes the results to be displayed in other window.  The default\nvalue is thing at point.\"\n  (interactive\n   (list\n    (if (cider--prompt-for-symbol-p current-prefix-arg)\n        (completing-read \"Resource: \"\n                         (cider-sync-request:resources-list)\n                         nil nil\n                         (thing-at-point 'filename))\n      (or (thing-at-point 'filename) \"\"))))\n  (cider-ensure-op-supported \"resource\")\n  (when (= (length path) 0)\n    (error \"Cannot find resource for empty path\"))\n  (if-let* ((resource (cider-sync-request:resource path))\n            (buffer (cider-find-file resource)))\n      (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg))\n    (if (cider--prompt-for-symbol-p current-prefix-arg)\n        (error \"Cannot find resource %s\" path)\n      (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg)))\n        (call-interactively 'cider-find-resource)))))\n\n(defun cider--invert-prefix-arg (arg)\n  \"Invert the effect of prefix value ARG on `cider-prompt-for-symbol'.\nThis function preserves the `other-window' meaning of ARG.\"\n  (let ((narg (prefix-numeric-value arg)))\n    (pcase narg\n      (16 -1)   ; empty empty -> -\n      (-1 16)   ; - -> empty empty\n      (4 nil)   ; empty -> no-prefix\n      (_ 4)))) ; no-prefix -> empty\n\n(defun cider--prefix-invert-prompt-p (arg)\n  \"Test prefix value ARG for its effect on `cider-prompt-for-symbol`.\"\n  (let ((narg (prefix-numeric-value arg)))\n    (pcase narg\n      (16 t) ; empty empty\n      (4 t)  ; empty\n      (_ nil))))\n\n(defun cider--prompt-for-symbol-p (&optional prefix)\n  \"Check if cider should prompt for symbol.\nTests againsts PREFIX and the value of `cider-prompt-for-symbol'.\nInvert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be.\"\n  (if (cider--prefix-invert-prompt-p prefix)\n      (not cider-prompt-for-symbol) cider-prompt-for-symbol))\n\n(defun cider--find-ns (ns &optional other-window)\n  \"Find the file containing NS's definition.\nOptionally open it in a different window if OTHER-WINDOW is truthy.\"\n  (if-let* ((path (cider-sync-request:ns-path ns)))\n      (cider-jump-to (cider-find-file path) nil other-window)\n    (user-error \"Can't find namespace `%s'\" ns)))\n\n;;;###autoload\n(defun cider-find-ns (&optional arg ns)\n  \"Find the file containing NS.\nA prefix ARG of `-` or a double prefix argument causes\nthe results to be displayed in a different window.\"\n  (interactive \"P\")\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"ns-path\")\n  (if ns\n      (cider--find-ns ns)\n    (let* ((namespaces (cider-sync-request:ns-list))\n           (ns (completing-read \"Find namespace: \" namespaces)))\n      (cider--find-ns ns (cider--open-other-window-p arg)))))\n\n;;;###autoload\n(defun cider-find-keyword (&optional arg)\n  \"Find the namespace of the keyword at point and its first occurrence there.\n\nFor instance - if the keyword at point is \\\":cider.demo/keyword\\\", this command\nwould find the namespace \\\"cider.demo\\\" and afterwards find the first mention\nof \\\"::keyword\\\" there.\n\nPrompt according to prefix ARG and `cider-prompt-for-symbol'.\nA single or double prefix argument inverts the meaning of\n`cider-prompt-for-symbol'.  A prefix of `-` or a double prefix argument causes\nthe results to be displayed in a different window.  The default value is\nthing at point.\"\n  (interactive \"P\")\n  (cider-ensure-connected)\n  (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back)))\n               (if (or cider-prompt-for-symbol arg)\n                   (read-string\n                    (format \"Keyword (default %s): \" kw-at-point)\n                    nil nil kw-at-point)\n                 kw-at-point)))\n         (ns-qualifier (and\n                        (string-match \"^:+\\\\(.+\\\\)/.+$\" kw)\n                        (match-string 1 kw)))\n         (kw-ns (if ns-qualifier\n                    (cider-resolve-alias (cider-current-ns) ns-qualifier)\n                  (cider-current-ns)))\n         (kw-to-find (concat \"::\" (replace-regexp-in-string \"^:+\\\\(.+/\\\\)?\" \"\" kw))))\n\n    (when (and ns-qualifier (string= kw-ns (cider-current-ns)))\n      (error \"Could not resolve alias `%s' in `%s'\" ns-qualifier (cider-current-ns)))\n    (cider--find-ns kw-ns arg)\n    (search-forward-regexp kw-to-find nil 'noerror)))\n\n;;; xref integration\n;;\n;; xref.el was introduced in Emacs 25.1.\n;; CIDER's xref backend was added in CIDER 1.2.\n(defun cider--xref-backend ()\n  \"Used for xref integration.\"\n  ;; Check if `cider-nrepl` middleware is loaded. Allows fallback to other xref\n  ;; backends, if cider-nrepl is not loaded.\n  (when (cider-nrepl-op-supported-p \"ns-path\" nil 'skip-ensure)\n    'cider))\n\n(cl-defmethod xref-backend-identifier-at-point ((_backend (eql cider)))\n  \"Return the relevant identifier at point.\"\n  (cider-symbol-at-point 'look-back))\n\n(defun cider--var-to-xref-location (var)\n  \"Get location of definition of VAR.\"\n  (when-let* ((info (cider-var-info var))\n              (line (nrepl-dict-get info \"line\"))\n              (file (nrepl-dict-get info \"file\"))\n              (buf (cider--find-buffer-for-file file)))\n    (xref-make-buffer-location\n     buf\n     (with-current-buffer buf\n       (save-excursion\n         (goto-char 0)\n         (forward-line (1- line))\n         (back-to-indentation)\n         (point))))))\n\n(cl-defmethod xref-backend-definitions ((_backend (eql cider)) var)\n  \"Find definitions of VAR.\"\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"ns-path\")\n  (when-let* ((loc (cider--var-to-xref-location var)))\n    (list (xref-make var loc))))\n\n(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql cider)))\n  \"Return the completion table for identifiers.\"\n  (cider-ensure-connected)\n  (when-let* ((ns (cider-current-ns))\n              (results (cider-sync-request:ns-vars ns)))\n    results))\n\n(cl-defmethod xref-backend-references ((_backend (eql cider)) var)\n  \"Find references of VAR.\"\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"fn-refs\")\n  (when-let* ((ns (cider-current-ns))\n              (results (cider-sync-request:fn-refs ns var)))\n    (mapcar (lambda (info)\n              (let* ((filename (nrepl-dict-get info \"file\"))\n                     (column (nrepl-dict-get info \"column\"))\n                     (line (nrepl-dict-get info \"line\"))\n                     (loc (xref-make-file-location filename line column)))\n                (xref-make filename loc)))\n            results)))\n\n(cl-defmethod xref-backend-apropos ((_backend (eql cider)) pattern)\n  \"Find all symbols that match regexp PATTERN.\"\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"apropos\")\n  (when-let* ((ns (cider-current-ns))\n              (results (cider-sync-request:apropos pattern ns t t completion-ignore-case)))\n    (mapcar (lambda (info)\n              (let* ((symbol (nrepl-dict-get info \"name\"))\n                     (loc (cider--var-to-xref-location symbol))\n                     (type (nrepl-dict-get info \"type\"))\n                     (doc (nrepl-dict-get info \"doc\")))\n                (xref-make (format \"[%s] %s\\n  %s\" (propertize symbol 'face 'bold) (capitalize type) doc)\n                           loc)))\n            results)))\n\n(provide 'cider-find)\n;;; cider-find.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-format.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53234915,"end":53234954},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53234954},"to":{"change":3,"start":53229628,"end":53229628},"introduced_by":3}],"inode":{"change":3,"pos":53229628}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53229628},"to":{"change":3,"start":53229629,"end":53234914},"introduced_by":3}],"inode":{"change":3,"pos":53229628}},"content":[{"Del":";;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \n;;         Artur Malabarba \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Middleware-powered code and EDN formatting functionality.\n\n;;; Code:\n\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'cider-client)\n(require 'cider-util)\n\n\f\n;; Format\n\n(defun cider--format-reindent (formatted start)\n  \"Reindent FORMATTED to align with buffer position START.\"\n  (let* ((start-column (save-excursion (goto-char start) (current-column)))\n         (indent-line (concat \"\\n\" (make-string start-column ? ))))\n    (replace-regexp-in-string \"\\n\" indent-line formatted)))\n\n\f\n;;; Format region\n\n(defun cider--format-region (start end formatter)\n  \"Format the contents of the given region.\n\nSTART and END represent the region's boundaries.\n\nFORMATTER is a function of one argument which is used to convert\nthe string contents of the region into a formatted string.\n\nUses the following heuristic to try to maintain point position:\n\n- Take a snippet of text starting at current position, up to 64 chars.\n- Search for the snippet, with lax whitespace, in the formatted text.\n  - If snippet is less than 64 chars (point was near end of buffer), search\n    from end instead of beginning.\n- Place point at match beginning, or `point-min' if no match.\"\n  (let* ((original (buffer-substring-no-properties start end))\n         (formatted (funcall formatter original))\n         (indented (cider--format-reindent formatted start)))\n    (unless (equal original indented)\n      (let* ((pos (point))\n             (pos-max (1+ (buffer-size)))\n             (l 64)\n             (endp (> (+ pos l) pos-max))\n             (snippet (thread-last\n                        (buffer-substring-no-properties\n                         pos (min (+ pos l) pos-max))\n                        (regexp-quote)\n                        (replace-regexp-in-string \"[[:space:]\\t\\n\\r]+\" \"[[:space:]\\t\\n\\r]*\"))))\n        (delete-region start end)\n        (insert indented)\n        (goto-char (if endp (point-max) (point-min)))\n        (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t)\n        (goto-char (or (match-beginning 0) start))\n        (when (looking-at-p \"\\n\") (forward-char))))))\n\n;;;###autoload\n(defun cider-format-region (start end)\n  \"Format the Clojure code in the current region.\nSTART and END represent the region's boundaries.\"\n  (interactive \"r\")\n  (cider-ensure-connected)\n  (cider--format-region start end\n                        (lambda (buf)\n                          (cider-sync-request:format-code buf cider-format-code-options))))\n\n\f\n;;; Format defun\n\n;;;###autoload\n(defun cider-format-defun ()\n  \"Format the code in the current defun.\"\n  (interactive)\n  (cider-ensure-connected)\n  (let ((defun-bounds (cider-defun-at-point 't)))\n    (cider-format-region (car defun-bounds) (cadr defun-bounds))))\n\n\f\n;;; Format buffer\n\n(defun cider--format-buffer (formatter)\n  \"Format the contents of the current buffer.\n\nUses FORMATTER, a function of one argument, to convert the string contents\nof the buffer into a formatted string.\"\n  (cider--format-region 1 (1+ (buffer-size)) formatter))\n\n;;;###autoload\n(defun cider-format-buffer ()\n  \"Format the Clojure code in the current buffer.\"\n  (interactive)\n  (check-parens)\n  (cider-ensure-connected)\n  (cider--format-buffer (lambda (buf)\n                          (cider-sync-request:format-code buf cider-format-code-options))))\n\n\f\n;;; Format EDN\n\n;;;###autoload\n(defun cider-format-edn-buffer ()\n  \"Format the EDN data in the current buffer.\"\n  (interactive)\n  (check-parens)\n  (cider-ensure-connected)\n  (cider--format-buffer (lambda (edn)\n                          (cider-sync-request:format-edn edn fill-column))))\n\n;;;###autoload\n(defun cider-format-edn-region (start end)\n  \"Format the EDN data in the current region.\nSTART and END represent the region's boundaries.\"\n  (interactive \"r\")\n  (cider-ensure-connected)\n  (let* ((start-column (save-excursion (goto-char start) (current-column)))\n         (right-margin (- fill-column start-column)))\n    (cider--format-region start end\n                          (lambda (edn)\n                            (cider-sync-request:format-edn edn right-margin)))))\n\n;;;###autoload\n(defun cider-format-edn-last-sexp ()\n  \"Format the EDN data of the last sexp.\"\n  (interactive)\n  (apply #'cider-format-edn-region (cider-sexp-at-point 'bounds)))\n\n(provide 'cider-format)\n;;; cider-format.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-inspector.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53229584,"end":53229626},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53229626},"to":{"change":3,"start":53207250,"end":53207250},"introduced_by":3}],"inode":{"change":3,"pos":53207250}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53207250},"to":{"change":3,"start":53207251,"end":53229583},"introduced_by":3}],"inode":{"change":3,"pos":53207250}},"content":[{"Del":";;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Vital Reactor, LLC\n;; Copyright © 2014-2022  Bozhidar Batsov and CIDER contributors\n\n;; Author: Ian Eslick \n;;         Bozhidar Batsov \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Clojure object inspector inspired by SLIME.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'easymenu)\n(require 'seq)\n(require 'cider-eval)\n\n;; ===================================\n;; Inspector Key Map and Derived Mode\n;; ===================================\n\n(defconst cider-inspector-buffer \"*cider-inspect*\")\n\n;;; Customization\n(defgroup cider-inspector nil\n  \"Presentation and behavior of the CIDER value inspector.\"\n  :prefix \"cider-inspector-\"\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-inspector-page-size 32\n  \"Default page size in paginated inspector view.\nThe page size can be also changed interactively within the inspector.\"\n  :type '(integer :tag \"Page size\" 32)\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-inspector-max-atom-length 150\n  \"Default max length of nested atoms before they are truncated.\n'Atom' here means any collection member that satisfies (complement coll?).\nThe max length can be also changed interactively within the inspector.\"\n  :type '(integer :tag \"Max atom length\" 150)\n  :package-version '(cider . \"1.1.0\"))\n\n(defcustom cider-inspector-max-coll-size 5\n  \"Default number of nested collection members to display before truncating.\nThe max size can be also changed interactively within the inspector.\"\n  :type '(integer :tag \"Max collection size\" 5)\n  :package-version '(cider . \"1.1.0\"))\n\n(defcustom cider-inspector-fill-frame nil\n  \"Controls whether the CIDER inspector window fills its frame.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-inspector-skip-uninteresting t\n  \"Controls whether to skip over uninteresting values in the inspector.\nOnly applies to navigation with `cider-inspector-prev-inspectable-object'\nand `cider-inspector-next-inspectable-object', values are still inspectable\nby clicking or navigating to them by other means.\"\n  :type 'boolean\n  :package-version '(cider . \"0.25.0\"))\n\n(defcustom cider-inspector-auto-select-buffer t\n  \"Determines if the inspector buffer should be auto selected.\"\n  :type 'boolean\n  :package-version '(cider . \"0.27.0\"))\n\n(defvar cider-inspector-uninteresting-regexp\n  (concat \"nil\"                      ; nils are not interesting\n          \"\\\\|:\" clojure--sym-regexp ; nor keywords\n          ;; FIXME: This range also matches \",\", is it on purpose?\n          \"\\\\|[+-.0-9]+\")            ; nor numbers. Note: BigInts, ratios etc. are interesting\n  \"Regexp of uninteresting and skippable values.\")\n\n(defvar cider-inspector-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map cider-popup-buffer-mode-map)\n    (define-key map (kbd \"RET\") #'cider-inspector-operate-on-point)\n    (define-key map [mouse-1] #'cider-inspector-operate-on-click)\n    (define-key map \"l\" #'cider-inspector-pop)\n    (define-key map \"g\" #'cider-inspector-refresh)\n    ;; Page-up/down\n    (define-key map [next] #'cider-inspector-next-page)\n    (define-key map [prior] #'cider-inspector-prev-page)\n    (define-key map \" \" #'cider-inspector-next-page)\n    (define-key map (kbd \"M-SPC\") #'cider-inspector-prev-page)\n    (define-key map (kbd \"S-SPC\") #'cider-inspector-prev-page)\n    (define-key map \"s\" #'cider-inspector-set-page-size)\n    (define-key map \"a\" #'cider-inspector-set-max-atom-length)\n    (define-key map \"c\" #'cider-inspector-set-max-coll-size)\n    (define-key map \"d\" #'cider-inspector-def-current-val)\n    (define-key map [tab] #'cider-inspector-next-inspectable-object)\n    (define-key map \"\\C-i\" #'cider-inspector-next-inspectable-object)\n    (define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object)\n    ;; Emacs translates S-TAB to BACKTAB on X.\n    (define-key map [backtab] #'cider-inspector-previous-inspectable-object)\n    (easy-menu-define cider-inspector-mode-menu map\n      \"Menu for CIDER's inspector.\"\n      `(\"CIDER Inspector\"\n        [\"Inspect\" cider-inspector-operate-on-point]\n        [\"Pop\" cider-inspector-pop]\n        [\"Refresh\" cider-inspector-refresh]\n        \"--\"\n        [\"Next Inspectable Object\" cider-inspector-next-inspectable-object]\n        [\"Previous Inspectable Object\" cider-inspector-previous-inspectable-object]\n        \"--\"\n        [\"Next Page\" cider-inspector-next-page]\n        [\"Previous Page\" cider-inspector-prev-page]\n        [\"Set Page Size\" cider-inspector-set-page-size]\n        [\"Set Max Atom Length\" cider-inspector-set-max-atom-length]\n        [\"Set Max Collection Size\" cider-inspector-set-max-coll-size]\n        [\"Define Var\" cider-inspector-def-current-val]\n        \"--\"\n        [\"Quit\" cider-popup-buffer-quit-function]\n        ))\n    map))\n\n(define-derived-mode cider-inspector-mode special-mode \"Inspector\"\n  \"Major mode for inspecting Clojure data structures.\n\n\\\\{cider-inspector-mode-map}\"\n  (set-syntax-table clojure-mode-syntax-table)\n  (setq-local electric-indent-chars nil)\n  (setq-local sesman-system 'CIDER)\n  (visual-line-mode 1))\n\n;;;###autoload\n(defun cider-inspect-last-sexp ()\n  \"Inspect the result of the the expression preceding point.\"\n  (interactive)\n  (cider-inspect-expr (cider-last-sexp) (cider-current-ns)))\n\n;;;###autoload\n(defun cider-inspect-defun-at-point ()\n  \"Inspect the result of the \\\"top-level\\\" expression at point.\"\n  (interactive)\n  (cider-inspect-expr (cider-defun-at-point) (cider-current-ns)))\n\n;;;###autoload\n(defun cider-inspect-last-result ()\n  \"Inspect the most recent eval result.\"\n  (interactive)\n  (cider-inspect-expr \"*1\" (cider-current-ns)))\n\n;;;###autoload\n(defun cider-inspect (&optional arg)\n  \"Inspect the result of the preceding sexp.\n\nWith a prefix argument ARG it inspects the result of the \\\"top-level\\\" form.\nWith a second prefix argument it prompts for an expression to eval and inspect.\"\n  (interactive \"p\")\n  (pcase arg\n    (1 (cider-inspect-last-sexp))\n    (4 (cider-inspect-defun-at-point))\n    (16 (call-interactively #'cider-inspect-expr))))\n\n(defvar cider-inspector-location-stack nil\n  \"A stack used to save point locations in inspector buffers.\nThese locations are used to emulate `save-excursion' between\n`cider-inspector-push' and `cider-inspector-pop' operations.\")\n\n(defvar cider-inspector-page-location-stack nil\n  \"A stack used to save point locations in inspector buffers.\nThese locations are used to emulate `save-excursion' between\n`cider-inspector-next-page' and `cider-inspector-prev-page' operations.\")\n\n(defvar cider-inspector-last-command nil\n  \"Contains the value of the most recently used `cider-inspector-*' command.\nThis is used as an alternative to the built-in `last-command'.  Whenever we\ninvoke any command through \\\\[execute-extended-command] and its variants,\nthe value of `last-command' is not set to the command it invokes.\")\n\n(defvar cider-inspector--current-repl nil\n  \"Contains the reference to the REPL where inspector was last invoked from.\nThis is needed for internal inspector buffer operations (push,\npop) to execute against the correct REPL session.\")\n\n;; Operations\n;;;###autoload\n(defun cider-inspect-expr (expr ns)\n  \"Evaluate EXPR in NS and inspect its value.\nInteractively, EXPR is read from the minibuffer, and NS the\ncurrent buffer's namespace.\"\n  (interactive (list (cider-read-from-minibuffer \"Inspect expression: \" (cider-sexp-at-point))\n                     (cider-current-ns)))\n  (setq cider-inspector--current-repl (cider-current-repl))\n  (when-let* ((value (cider-sync-request:inspect-expr\n                      expr ns\n                      cider-inspector-page-size\n                      cider-inspector-max-atom-length\n                      cider-inspector-max-coll-size)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-pop ()\n  \"Pop the last value off the inspector stack and render it.\nSee `cider-sync-request:inspect-pop' and `cider-inspector--render-value'.\"\n  (interactive)\n  (setq cider-inspector-last-command 'cider-inspector-pop)\n  (when-let* ((value (cider-sync-request:inspect-pop)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-push (idx)\n  \"Inspect the value at IDX in the inspector stack and render it.\nSee `cider-sync-request:inspect-push' and `cider-inspector--render-value'\"\n  (push (point) cider-inspector-location-stack)\n  (when-let* ((value (cider-sync-request:inspect-push idx)))\n    (cider-inspector--render-value value)\n    (cider-inspector-next-inspectable-object 1)))\n\n(defun cider-inspector-refresh ()\n  \"Re-render the currently inspected value.\nSee `cider-sync-request:inspect-refresh' and `cider-inspector--render-value'\"\n  (interactive)\n  (when-let* ((value (cider-sync-request:inspect-refresh)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-next-page ()\n  \"Jump to the next page when inspecting a paginated sequence/map.\n\nDoes nothing if already on the last page.\"\n  (interactive)\n  (push (point) cider-inspector-page-location-stack)\n  (when-let* ((value (cider-sync-request:inspect-next-page)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-prev-page ()\n  \"Jump to the previous page when expecting a paginated sequence/map.\n\nDoes nothing if already on the first page.\"\n  (interactive)\n  (setq cider-inspector-last-command 'cider-inspector-prev-page)\n  (when-let* ((value (cider-sync-request:inspect-prev-page)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-set-page-size (page-size)\n  \"Set the page size in pagination mode to the specified PAGE-SIZE.\n\nCurrent page will be reset to zero.\"\n  (interactive (list (read-number \"Page size: \" cider-inspector-page-size)))\n  (when-let ((value (cider-sync-request:inspect-set-page-size page-size)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-set-max-atom-length (max-length)\n  \"Set the max length of nested atoms to MAX-LENGTH.\"\n  (interactive (list (read-number \"Max atom length: \" cider-inspector-max-atom-length)))\n  (when-let ((value (cider-sync-request:inspect-set-max-atom-length max-length)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-set-max-coll-size (max-size)\n  \"Set the number of nested collection members to display before truncating.\nMAX-SIZE is the new value.\"\n  (interactive (list (read-number \"Max collection size: \" cider-inspector-max-coll-size)))\n  (when-let ((value (cider-sync-request:inspect-set-max-coll-size max-size)))\n    (cider-inspector--render-value value)))\n\n(defun cider-inspector-def-current-val (var-name ns)\n  \"Defines a var with VAR-NAME in current namespace.\n\nDoesn't modify current page.  When called interactively NS defaults to\ncurrent-namespace.\"\n  (interactive (let ((ns (cider-current-ns)))\n                 (list (read-from-minibuffer (concat \"Var name: \" ns \"/\"))\n                       ns)))\n  (setq cider-inspector--current-repl (cider-current-repl))\n  (when-let* ((value (cider-sync-request:inspect-def-current-val ns var-name)))\n    (cider-inspector--render-value value)\n    (message \"%s#'%s/%s = %s\" cider-eval-result-prefix ns var-name value)))\n\n;; nREPL interactions\n(defun cider-sync-request:inspect-pop ()\n  \"Move one level up in the inspector stack.\"\n  (thread-first '(\"op\" \"inspect-pop\")\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-push (idx)\n  \"Inspect the inside value specified by IDX.\"\n  (thread-first `(\"op\" \"inspect-push\"\n                  \"idx\" ,idx)\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-refresh ()\n  \"Re-render the currently inspected value.\"\n  (thread-first '(\"op\" \"inspect-refresh\")\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-next-page ()\n  \"Jump to the next page in paginated collection view.\"\n  (thread-first '(\"op\" \"inspect-next-page\")\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-prev-page ()\n  \"Jump to the previous page in paginated collection view.\"\n  (thread-first '(\"op\" \"inspect-prev-page\")\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-set-page-size (page-size)\n  \"Set the page size in paginated view to PAGE-SIZE.\"\n  (thread-first `(\"op\" \"inspect-set-page-size\"\n                  \"page-size\" ,page-size)\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-set-max-atom-length (max-length)\n  \"Set the max length of nested atoms to MAX-LENGTH.\"\n  (thread-first `(\"op\" \"inspect-set-max-atom-length\"\n                  \"max-atom-length\" ,max-length)\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-set-max-coll-size (max-size)\n  \"Set the number of nested collection members to display before truncating.\nMAX-SIZE is the new value.\"\n  (thread-first `(\"op\" \"inspect-set-max-coll-size\"\n                  \"max-coll-size\" ,max-size)\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-def-current-val (ns var-name)\n  \"Defines a var with VAR-NAME in NS with the current inspector value.\"\n  (thread-first `(\"op\" \"inspect-def-current-value\"\n                  \"ns\" ,ns\n                  \"var-name\" ,var-name)\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n(defun cider-sync-request:inspect-expr (expr ns page-size max-atom-length max-coll-size)\n  \"Evaluate EXPR in context of NS and inspect its result.\nSet the page size in paginated view to PAGE-SIZE, maximum length of atomic\ncollection members to MAX-ATOM-LENGTH, and maximum size of nested collections to\nMAX-COLL-SIZE if non nil.\"\n  (thread-first (append (nrepl--eval-request expr ns)\n                        `(\"inspect\" \"true\"\n                          ,@(when page-size\n                              `(\"page-size\" ,page-size))\n                          ,@(when max-atom-length\n                              `(\"max-atom-length\" ,max-atom-length))\n                          ,@(when max-coll-size\n                              `(\"max-coll-size\" ,max-coll-size))))\n                (cider-nrepl-send-sync-request cider-inspector--current-repl)\n                (nrepl-dict-get \"value\")))\n\n;; Render Inspector from Structured Values\n(defun cider-inspector--render-value (value)\n  \"Render VALUE.\"\n  (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode 'ancillary)\n  (cider-inspector-render cider-inspector-buffer value)\n  (cider-popup-buffer-display cider-inspector-buffer cider-inspector-auto-select-buffer)\n  (when cider-inspector-fill-frame (delete-other-windows))\n  (ignore-errors (cider-inspector-next-inspectable-object 1))\n  (with-current-buffer cider-inspector-buffer\n    (when (eq cider-inspector-last-command 'cider-inspector-pop)\n      (setq cider-inspector-last-command nil)\n      ;; Prevents error message being displayed when we try to pop\n      ;; from the top-level of a data structure\n      (when cider-inspector-location-stack\n        (goto-char (pop cider-inspector-location-stack))))\n\n    (when (eq cider-inspector-last-command 'cider-inspector-prev-page)\n      (setq cider-inspector-last-command nil)\n      ;; Prevents error message being displayed when we try to\n      ;; go to a prev-page from the first page\n      (when cider-inspector-page-location-stack\n        (goto-char (pop cider-inspector-page-location-stack))))))\n\n(defun cider-inspector-render (buffer str)\n  \"Render STR in BUFFER.\"\n  (with-current-buffer buffer\n    (cider-inspector-mode)\n    (let ((inhibit-read-only t))\n      (condition-case nil\n          (cider-inspector-render* (car (read-from-string str)))\n        (error (insert \"\\nInspector error for: \" str))))\n    (goto-char (point-min))))\n\n(defun cider-inspector-render* (elements)\n  \"Render ELEMENTS.\"\n  (dolist (el elements)\n    (cider-inspector-render-el* el)))\n\n(defun cider-inspector-render-el* (el)\n  \"Render EL.\"\n  (cond ((symbolp el) (insert (symbol-name el)))\n        ((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face)))\n        ((and (consp el) (eq (car el) :newline))\n         (insert \"\\n\"))\n        ((and (consp el) (eq (car el) :value))\n         (cider-inspector-render-value (cadr el) (cl-caddr el)))\n        (t (message \"Unrecognized inspector object: %s\" el))))\n\n(defun cider-inspector-render-value (value idx)\n  \"Render VALUE at IDX.\"\n  (cider-propertize-region\n      (list 'cider-value-idx idx\n            'mouse-face 'highlight)\n    (cider-inspector-render-el* (cider-font-lock-as-clojure value))))\n\n\n;; ===================================================\n;; Inspector Navigation (lifted from SLIME inspector)\n;; ===================================================\n\n(defun cider-find-inspectable-object (direction limit)\n  \"Find the next/previous inspectable object.\nDIRECTION can be either 'next or 'prev.\nLIMIT is the maximum or minimum position in the current buffer.\n\nReturn a list of two values: If an object could be found, the\nstarting position of the found object and T is returned;\notherwise LIMIT and NIL is returned.\"\n  (let ((finder (cl-ecase direction\n                  (next 'next-single-property-change)\n                  (prev 'previous-single-property-change))))\n    (let ((prop nil) (curpos (point)))\n      (while (and (not prop) (not (= curpos limit)))\n        (let ((newpos (funcall finder curpos 'cider-value-idx nil limit)))\n          (setq prop (get-text-property newpos 'cider-value-idx))\n          (setq curpos newpos)))\n      (list curpos (and prop t)))))\n\n(defun cider-inspector-next-inspectable-object (arg)\n  \"Move point to the next inspectable object.\nWith optional ARG, move across that many objects.\nIf ARG is negative, move backwards.\"\n  (interactive \"p\")\n  (let ((maxpos (point-max)) (minpos (point-min))\n        (previously-wrapped-p nil))\n    ;; Forward.\n    (while (> arg 0)\n      (seq-let (pos foundp) (cider-find-inspectable-object 'next maxpos)\n        (if foundp\n            (progn (goto-char pos)\n                   (unless (and cider-inspector-skip-uninteresting\n                                (looking-at-p cider-inspector-uninteresting-regexp))\n                     (setq arg (1- arg))\n                     (setq previously-wrapped-p nil)))\n          (if (not previously-wrapped-p) ; cycle detection\n              (progn (goto-char minpos) (setq previously-wrapped-p t))\n            (error \"No inspectable objects\")))))\n    ;; Backward.\n    (while (< arg 0)\n      (seq-let (pos foundp) (cider-find-inspectable-object 'prev minpos)\n        ;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page\n        ;; as a presentation at the beginning of the buffer; skip\n        ;; that.  (Notice how this problem can not arise in ``Forward.'')\n        (if (and foundp (/= pos minpos))\n            (progn (goto-char pos)\n                   (unless (and cider-inspector-skip-uninteresting\n                                (looking-at-p cider-inspector-uninteresting-regexp))\n                     (setq arg (1+ arg))\n                     (setq previously-wrapped-p nil)))\n          (if (not previously-wrapped-p) ; cycle detection\n              (progn (goto-char maxpos) (setq previously-wrapped-p t))\n            (error \"No inspectable objects\")))))))\n\n(defun cider-inspector-previous-inspectable-object (arg)\n  \"Move point to the previous inspectable object.\nWith optional ARG, move across that many objects.\nIf ARG is negative, move forwards.\"\n  (interactive \"p\")\n  (cider-inspector-next-inspectable-object (- arg)))\n\n(defun cider-inspector-property-at-point ()\n  \"Return property at point.\"\n  (let* ((properties '(cider-value-idx cider-range-button\n                                       cider-action-number))\n         (find-property\n          (lambda (point)\n            (cl-loop for property in properties\n                     for value = (get-text-property point property)\n                     when value\n                     return (list property value)))))\n    (or (funcall find-property (point))\n        (funcall find-property (max (point-min) (1- (point)))))))\n\n(defun cider-inspector-operate-on-point ()\n  \"Invoke the command for the text at point.\n1. If point is on a value then recursively call the inspector on\nthat value.\n2. If point is on an action then call that action.\n3. If point is on a range-button fetch and insert the range.\"\n  (interactive)\n  (seq-let (property value) (cider-inspector-property-at-point)\n    (cl-case property\n      (cider-value-idx\n       (cider-inspector-push value))\n      ;; TODO: range and action handlers\n      (t (error \"No object at point\")))))\n\n(defun cider-inspector-operate-on-click (event)\n  \"Move to EVENT's position and operate the part.\"\n  (interactive \"@e\")\n  (let ((point (posn-point (event-end event))))\n    (cond ((and point\n                (or (get-text-property point 'cider-value-idx)))\n           (goto-char point)\n           (cider-inspector-operate-on-point))\n          (t\n           (error \"No clickable part here\")))))\n\n(provide 'cider-inspector)\n\n;;; cider-inspector.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-jar.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53207212,"end":53207248},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53207248},"to":{"change":3,"start":53201671,"end":53201671},"introduced_by":3}],"inode":{"change":3,"pos":53201671}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53201671},"to":{"change":3,"start":53201672,"end":53207211},"introduced_by":3}],"inode":{"change":3,"pos":53201671}},"content":[{"Del":";;; cider-jar.el --- Jar functionality for Clojure -*- lexical-binding: t -*-\n\n;; Copyright © 2022 Arne Brasseur\n;;\n;; Author: Arne Brasseur \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Dealing with JAR (Java archive) files, which are really just zip files in\n;; disguise.  In particular downloading and retrieving the cider-nrepl jar.\n\n;;; Code:\n\n(require 'url)\n(require 'arc-mode)\n(require 'map)\n\n\n(defvar cider-jar-cache-dir (expand-file-name \"cider-cache\" user-emacs-directory)\n  \"Location where we store downloaded files for later use.\")\n\n(defvar cider-jar-content-cache (make-hash-table :test #'equal)\n  \"Nested hash table of jar-path -> file-path -> bool.\nThis provides an efficient check to see if a file exists in a jar or not.\")\n\n(defun cider-jar-clojars-url (group artifact version)\n  \"URL to download a specific jar from Clojars.\nGROUP, ARTIFACT, and VERSION are the components of the Maven coordinates.\"\n  (concat \"https://repo.clojars.org/\" group \"/\" artifact \"/\"\n          version\n          \"/cider-nrepl-\"\n          version\n          \".jar\"))\n\n(defun cider-jar-find-or-fetch (group artifact version)\n  \"Download the given jar off clojars and cache it.\n\nGROUP, ARTIFACT, and VERSION are the components of the Maven coordinates.\nReturns the path to the jar.\"\n  (let* ((m2-path (expand-file-name (concat \"~/.m2/repository/\" group \"/\" artifact \"/\" version \"/\" artifact \"-\" version \".jar\")))\n         (clojars-url (cider-jar-clojars-url group artifact version))\n         (cache-path (expand-file-name (replace-regexp-in-string \"https://\" \"\" clojars-url) cider-jar-cache-dir)))\n    (cond\n     ((file-exists-p m2-path) m2-path)\n     ((file-exists-p cache-path) cache-path)\n     (t\n      (make-directory (file-name-directory cache-path) t)\n      (url-copy-file clojars-url cache-path)\n      cache-path))))\n\n(defun cider-jar--archive-zip-summarize ()\n  \"Forked version of `archive-zip-summarize'.\nOnly read the information we need, and be version independent.\"\n  (goto-char (- (point-max) (- 22 18)))\n  (search-backward-regexp \"[P]K\\005\\006\")\n  (let ((p (archive-l-e (+ (point) 16) 4))\n        files)\n    (when (or (= p #xffffffff) (= p -1))\n      ;; If the offset of end-of-central-directory is 0xFFFFFFFF, this\n      ;; is a Zip64 extended ZIP file format, and we need to glean the\n      ;; info from Zip64 records instead.\n      ;;\n      ;; First, find the Zip64 end-of-central-directory locator.\n      (search-backward \"PK\\006\\007\")\n      (setq p (+ (point-min)\n                 (archive-l-e (+ (point) 8) 8)))\n      (goto-char p)\n      ;; We should be at Zip64 end-of-central-directory record now.\n      (or (string= \"PK\\006\\006\" (buffer-substring p (+ p 4)))\n          (error \"Unrecognized ZIP file format\"))\n      ;; Offset to central directory:\n      (setq p (archive-l-e (+ p 48) 8)))\n    (setq p (+ p (point-min)))\n    (while (string= \"PK\\001\\002\" (buffer-substring p (+ p 4)))\n      (let* ((fnlen   (archive-l-e (+ p 28) 2))\n             (exlen   (archive-l-e (+ p 30) 2))\n             (fclen   (archive-l-e (+ p 32) 2))\n             (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))\n                        (decode-coding-string\n                         str archive-file-name-coding-system))))\n        (setq files (cons efnname files)\n              p (+ p 46 fnlen exlen fclen))))\n    files))\n\n(defun cider-jar-contents (jarfile)\n  \"Get the list of filenames in a jar (or zip) file.\nJARFILE is the location of the archive.\"\n  (with-temp-buffer\n    (set-buffer-multibyte nil)\n    (setq buffer-file-coding-system 'binary)\n    (insert-file-contents-literally jarfile nil)\n    (cider-jar--archive-zip-summarize)))\n\n(defun cider-jar-contents-cached (jarfile)\n  \"Like cider-jar-contents, but cached.\n\nInstead of returning a list of strings this returns a hash table of string\nkeys and values `t`, for quick lookup.  JARFILE is the location of the\narchive.\"\n  (let ((m (map-elt cider-jar-content-cache jarfile)))\n    (if m\n        m\n      (let ((m (make-hash-table :test #'equal)))\n        (seq-do (lambda (path)\n                  (puthash path t m))\n                (cider-jar-contents jarfile))\n        (puthash jarfile m cider-jar-content-cache)\n        m))))\n\n(defun cider-jar-contains-p (jarfile name)\n  \"Does the JARFILE contain a file with the given NAME?\"\n  (map-elt (cider-jar-contents-cached jarfile) name))\n\n(defun cider-jar-retrieve-resource (jarfile name)\n  \"Extract a file NAME from a JARFILE as a string.\"\n  (make-directory archive-tmpdir :make-parents)\n  (when (cider-jar-contains-p jarfile name)\n    (let ((default-directory archive-tmpdir))\n      (with-temp-buffer\n        (set-buffer-multibyte nil)\n        (setq buffer-file-coding-system 'binary)\n        (archive-zip-extract jarfile name)\n        (buffer-substring-no-properties (point-min) (point-max))))))\n\n(provide 'cider-jar)\n;;; cider-jar.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-macroexpansion.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53201622,"end":53201669},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53201669},"to":{"change":3,"start":53193550,"end":53193550},"introduced_by":3}],"inode":{"change":3,"pos":53193550}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53193550},"to":{"change":3,"start":53193551,"end":53201621},"introduced_by":3}],"inode":{"change":3,"pos":53193550}},"content":[{"Del":";;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Macro expansion support.\n\n;;; Code:\n\n(require 'cider-mode)\n(require 'subr-x)\n\n(defconst cider-macroexpansion-buffer \"*cider-macroexpansion*\")\n\n(defcustom cider-macroexpansion-display-namespaces 'tidy\n  \"Determines if namespaces are displayed in the macroexpansion buffer.\nPossible values are:\n\n  'qualified ;=> Vars are fully-qualified in the expansion\n  'none      ;=> Vars are displayed without namespace qualification\n  'tidy      ;=> Vars that are :refer-ed or defined in the current namespace are\n                 displayed with their simple name, non-referred vars from other\n                 namespaces are referred using the alias for that namespace (if\n                 defined), other vars are displayed fully qualified.\"\n  :type '(choice (const :tag \"Suppress namespaces\" none)\n                 (const :tag \"Show fully-qualified namespaces\" qualified)\n                 (const :tag \"Show namespace aliases\" tidy))\n  :group 'cider\n  :package-version '(cider . \"0.7.0\"))\n\n(defcustom cider-macroexpansion-print-metadata nil\n  \"Determines if metadata is included in macroexpansion results.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.9.0\"))\n\n(defun cider-sync-request:macroexpand (expander expr &optional display-namespaces)\n  \"Macroexpand, using EXPANDER, the given EXPR.\nThe default for DISPLAY-NAMESPACES is taken from\n`cider-macroexpansion-display-namespaces'.\"\n  (cider-ensure-op-supported \"macroexpand\")\n  (thread-first `(\"op\" \"macroexpand\"\n                  \"expander\" ,expander\n                  \"code\" ,expr\n                  \"ns\" ,(cider-current-ns)\n                  \"display-namespaces\" ,(or display-namespaces\n                                            (symbol-name cider-macroexpansion-display-namespaces)))\n                (nconc (when cider-macroexpansion-print-metadata\n                         '(\"print-meta\" \"true\")))\n                (cider-nrepl-send-sync-request)\n                (nrepl-dict-get \"expansion\")))\n\n(defun cider-macroexpand-undo (&optional arg)\n  \"Undo the last macroexpansion, using `undo-only'.\nARG is passed along to `undo-only'.\"\n  (interactive)\n  (let ((inhibit-read-only t))\n    (undo-only arg)))\n\n(defvar cider-last-macroexpand-expression nil\n  \"Specify the last macroexpansion performed.\nThis variable specifies both what was expanded and the expander.\")\n\n(defun cider-macroexpand-expr (expander expr)\n  \"Macroexpand, use EXPANDER, the given EXPR.\"\n  (when-let* ((expansion (cider-sync-request:macroexpand expander expr)))\n    (setq cider-last-macroexpand-expression expr)\n    (cider-initialize-macroexpansion-buffer expansion (cider-current-ns))))\n\n(defun cider-macroexpand-expr-inplace (expander)\n  \"Substitute the form preceding point with its macroexpansion using EXPANDER.\"\n  (interactive)\n  (let* ((expansion (cider-sync-request:macroexpand expander (cider-last-sexp)))\n         (bounds (cons (save-excursion (clojure-backward-logical-sexp 1) (point)) (point))))\n    (cider-redraw-macroexpansion-buffer\n     expansion (current-buffer) (car bounds) (cdr bounds))))\n\n(defun cider-macroexpand-again ()\n  \"Repeat the last macroexpansion.\"\n  (interactive)\n  (cider-initialize-macroexpansion-buffer cider-last-macroexpand-expression (cider-current-ns)))\n\n;;;###autoload\n(defun cider-macroexpand-1 (&optional prefix)\n  \"Invoke \\\\=`macroexpand-1\\\\=` on the expression preceding point.\nIf invoked with a PREFIX argument, use \\\\=`macroexpand\\\\=` instead of\n\\\\=`macroexpand-1\\\\=`.\"\n  (interactive \"P\")\n  (let ((expander (if prefix \"macroexpand\" \"macroexpand-1\")))\n    (cider-macroexpand-expr expander (cider-last-sexp))))\n\n(defun cider-macroexpand-1-inplace (&optional prefix)\n  \"Perform inplace \\\\=`macroexpand-1\\\\=` on the expression preceding point.\nIf invoked with a PREFIX argument, use \\\\=`macroexpand\\\\=` instead of\n\\\\=`macroexpand-1\\\\=`.\"\n  (interactive \"P\")\n  (let ((expander (if prefix \"macroexpand\" \"macroexpand-1\")))\n    (cider-macroexpand-expr-inplace expander)))\n\n;;;###autoload\n(defun cider-macroexpand-all ()\n  \"Invoke \\\\=`macroexpand-all\\\\=` on the expression preceding point.\"\n  (interactive)\n  (cider-macroexpand-expr \"macroexpand-all\" (cider-last-sexp)))\n\n(defun cider-macroexpand-all-inplace ()\n  \"Perform inplace \\\\=`macroexpand-all\\\\=` on the expression preceding point.\"\n  (interactive)\n  (cider-macroexpand-expr-inplace \"macroexpand-all\"))\n\n(defun cider-initialize-macroexpansion-buffer (expansion ns)\n  \"Create a new Macroexpansion buffer with EXPANSION and namespace NS.\"\n  (pop-to-buffer (cider-create-macroexpansion-buffer))\n  (setq cider-buffer-ns ns)\n  (setq buffer-undo-list nil)\n  (let ((inhibit-read-only t)\n        (buffer-undo-list t))\n    (erase-buffer)\n    (insert (format \"%s\" expansion))\n    (goto-char (point-max))\n    (font-lock-ensure)))\n\n(defun cider-redraw-macroexpansion-buffer (expansion buffer start end)\n  \"Redraw the macroexpansion with new EXPANSION.\nText in BUFFER from START to END is replaced with new expansion,\nand point is placed after the expanded form.\"\n  (with-current-buffer buffer\n    (let ((buffer-read-only nil))\n      (goto-char start)\n      (delete-region start end)\n      (insert (format \"%s\" expansion))\n      (goto-char start)\n      (indent-sexp)\n      (forward-sexp))))\n\n(declare-function cider-mode \"cider-mode\")\n\n(defun cider-create-macroexpansion-buffer ()\n  \"Create a new macroexpansion buffer.\"\n  (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer 'select 'clojure-mode 'ancillary)\n    (cider-mode -1)\n    (cider-macroexpansion-mode 1)\n    (current-buffer)))\n\n(declare-function cider-find-var \"cider-find\")\n\n(defvar cider-macroexpansion-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"g\") #'cider-macroexpand-again)\n    (define-key map (kbd \"q\") #'cider-popup-buffer-quit-function)\n    (define-key map (kbd \"d\") #'cider-doc)\n    (define-key map (kbd \"j\") #'cider-javadoc)\n    (define-key map (kbd \".\") #'cider-find-var)\n    (define-key map (kbd \"m\") #'cider-macroexpand-1-inplace)\n    (define-key map (kbd \"a\") #'cider-macroexpand-all-inplace)\n    (define-key map (kbd \"u\") #'cider-macroexpand-undo)\n    (define-key map [remap undo] #'cider-macroexpand-undo)\n    (easy-menu-define cider-macroexpansion-mode-menu map\n      \"Menu for CIDER's doc mode\"\n      '(\"Macroexpansion\"\n        [\"Restart expansion\" cider-macroexpand-again]\n        [\"Macroexpand-1\" cider-macroexpand-1-inplace]\n        [\"Macroexpand-all\" cider-macroexpand-all-inplace]\n        [\"Macroexpand-undo\" cider-macroexpand-undo]\n        [\"Go to source\" cider-find-var]\n        [\"Go to doc\" cider-doc]\n        [\"Go to Javadoc\" cider-docview-javadoc]\n        [\"Quit\" cider-popup-buffer-quit-function]))\n    map))\n\n(define-minor-mode cider-macroexpansion-mode\n  \"Minor mode for CIDER macroexpansion.\"\n  :lighter \" Macroexpand\")\n\n(provide 'cider-macroexpansion)\n\n;;; cider-macroexpansion.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-mode.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53193511,"end":53193548},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53193548},"to":{"change":3,"start":53144822,"end":53144822},"introduced_by":3}],"inode":{"change":3,"pos":53144822}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53144822},"to":{"change":3,"start":53144823,"end":53193510},"introduced_by":3}],"inode":{"change":3,"pos":53144822}},"content":[{"Del":";;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Minor mode for REPL interactions.\n\n;;; Code:\n\n(require 'clojure-mode)\n(require 'cider-eval)\n(require 'cider-test) ; required only for the menu\n(require 'cider-eldoc)\n(require 'cider-resolve)\n(require 'cider-doc) ; required only for the menu\n(require 'cider-profile) ; required only for the menu\n(require 'cider-completion)\n(require 'cider-inspector)\n(require 'cider-find)\n(require 'subr-x)\n\n(defcustom cider-mode-line-show-connection t\n  \"If the mode-line lighter should detail the connection.\"\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider \"0.10.0\"))\n\n(defun cider--modeline-info ()\n  \"Return info for the cider mode modeline.\nInfo contains the connection type, project name and host:port endpoint.\"\n  (if-let* ((current-connection (ignore-errors (cider-current-repl))))\n      (with-current-buffer current-connection\n        (concat\n         (symbol-name cider-repl-type)\n         (when cider-mode-line-show-connection\n           (format \":%s@%s:%s\"\n                   (or (cider--project-name nrepl-project-dir) \"\")\n                   (pcase (plist-get nrepl-endpoint :host)\n                     (\"localhost\" \"\")\n                     (x x))\n                   (plist-get nrepl-endpoint :port)))))\n    \"not connected\"))\n\n;;;###autoload\n(defcustom cider-mode-line\n  '(:eval (format \" cider[%s]\" (cider--modeline-info)))\n  \"Mode line lighter for cider mode.\n\nThe value of this variable is a mode line template as in\n`mode-line-format'.  See Info Node `(elisp)Mode Line Format' for details\nabout mode line templates.\n\nCustomize this variable to change how cider mode displays its status in the\nmode line.  The default value displays the current connection.  Set this\nvariable to nil to disable the mode line entirely.\"\n  :group 'cider\n  :type 'sexp\n  :risky t\n  :package-version '(cider \"0.7.0\"))\n\n\f\n;;; Switching between REPL & source buffers\n\n(defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace)\n  \"Select the REPL-BUFFER, when possible in an existing window.\nWhen SET-NAMESPACE is t, sets the namespace in the REPL buffer to\nthat of the namespace in the Clojure source buffer.\"\n  (let ((buffer (current-buffer)))\n    ;; first we switch to the REPL buffer\n    (if cider-repl-display-in-current-window\n        (pop-to-buffer-same-window repl-buffer)\n      (pop-to-buffer repl-buffer))\n    ;; then if necessary we update its namespace\n    (when set-namespace\n      (cider-repl-set-ns (with-current-buffer buffer (cider-current-ns))))\n    (goto-char (point-max))))\n\n(defun cider-switch-to-repl-buffer (&optional set-namespace)\n  \"Switch to current REPL buffer, when possible in an existing window.\nThe type of the REPL is inferred from the mode of current buffer.  With a\nprefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that of\nthe namespace in the Clojure source buffer\"\n  (interactive \"P\")\n  (cider--switch-to-repl-buffer\n   (cider-current-repl nil 'ensure)\n   set-namespace))\n\n(declare-function cider-load-buffer \"cider-eval\")\n\n(defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace)\n  \"Load the current buffer into the matching REPL buffer and switch to it.\nWhen SET-NAMESPACE is true, we'll also set the REPL's ns to match that of the\nClojure buffer.\"\n  (interactive \"P\")\n  (cider-load-buffer)\n  (cider-switch-to-repl-buffer set-namespace))\n\n(defun cider-switch-to-last-clojure-buffer ()\n  \"Switch to the last Clojure buffer.\nThe default keybinding for this command is\nthe same as variable `cider-switch-to-repl-buffer',\nso that it is very convenient to jump between a\nClojure buffer and the REPL buffer.\"\n  (interactive)\n  (if (derived-mode-p 'cider-repl-mode)\n      (let* ((a-buf)\n             (the-buf (let ((repl-type (cider-repl-type-for-buffer)))\n                        (seq-find (lambda (b)\n                                    (unless (with-current-buffer b (derived-mode-p 'cider-repl-mode))\n                                      (when-let* ((type (cider-repl-type-for-buffer b)))\n                                        (unless a-buf\n                                          (setq a-buf b))\n                                        (or (eq type 'multi)\n                                            (eq type repl-type)))))\n                                  (buffer-list)))))\n        (if-let* ((buf (or the-buf a-buf)))\n            (if cider-repl-display-in-current-window\n                (pop-to-buffer-same-window buf)\n              (pop-to-buffer buf))\n          (user-error \"No Clojure buffer found\")))\n    (user-error \"Not in a CIDER REPL buffer\")))\n\n(defun cider-find-and-clear-repl-output (&optional clear-repl)\n  \"Find the current REPL buffer and clear it.\nWith a prefix argument CLEAR-REPL the command clears the entire REPL\nbuffer.  Returns to the buffer in which the command was invoked.  See also\nthe related commands `cider-repl-clear-buffer' and\n`cider-repl-clear-output'.\"\n  (interactive \"P\")\n  (let ((origin-buffer (current-buffer)))\n    (switch-to-buffer (cider-current-repl nil 'ensure))\n    (if clear-repl\n        (cider-repl-clear-buffer)\n      (cider-repl-clear-output))\n    (switch-to-buffer origin-buffer)))\n\n;;; cider-run\n(defvar cider--namespace-history nil\n  \"History of user input for namespace prompts.\")\n\n(defun cider--var-namespace (var)\n  \"Return the namespace of VAR.\nVAR is a fully qualified Clojure variable name as a string.\"\n  (replace-regexp-in-string \"\\\\(?:#'\\\\)?\\\\(.*\\\\)/.*\" \"\\\\1\" var))\n\n(defun cider-run (&optional function)\n  \"Run -main or FUNCTION, prompting for its namespace if necessary.\nWith a prefix argument, prompt for function to run instead of -main.\"\n  (interactive (list (when current-prefix-arg (read-string \"Function name: \"))))\n  (cider-ensure-connected)\n  (let ((name (or function \"-main\")))\n    (when-let* ((response (cider-nrepl-send-sync-request\n                           `(\"op\" \"ns-list-vars-by-name\"\n                             \"name\" ,name))))\n      (if-let* ((vars (split-string (substring (nrepl-dict-get response \"var-list\") 1 -1))))\n          (cider-interactive-eval\n           (if (= (length vars) 1)\n               (concat \"(\" (car vars) \")\")\n             (let* ((completions (mapcar #'cider--var-namespace vars))\n                    (def (or (car cider--namespace-history)\n                             (car completions))))\n               (format \"(#'%s/%s)\"\n                       (completing-read (format \"Namespace (%s): \" def)\n                                        completions nil t nil\n                                        'cider--namespace-history def)\n                       name))))\n        (user-error \"No %s var defined in any namespace\" (cider-propertize name 'fn))))))\n\n;;; Insert (and eval) in REPL functionality\n(defvar cider-insert-commands-map\n  (let ((map (define-prefix-command 'cider-insert-commands-map)))\n    ;; single key bindings defined last for display in menu\n    (define-key map (kbd \"e\") #'cider-insert-last-sexp-in-repl)\n    (define-key map (kbd \"d\") #'cider-insert-defun-in-repl)\n    (define-key map (kbd \"r\") #'cider-insert-region-in-repl)\n    (define-key map (kbd \"n\") #'cider-insert-ns-form-in-repl)\n\n    ;; duplicates with C- for convenience\n    (define-key map (kbd \"C-e\") #'cider-insert-last-sexp-in-repl)\n    (define-key map (kbd \"C-d\") #'cider-insert-defun-in-repl)\n    (define-key map (kbd \"C-r\") #'cider-insert-region-in-repl)\n    (define-key map (kbd \"C-n\") #'cider-insert-ns-form-in-repl)))\n\n(defcustom cider-switch-to-repl-on-insert t\n  \"Whether to switch to the REPL when inserting a form into the REPL.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.21.0\"))\n\n(defcustom cider-invert-insert-eval-p nil\n  \"Whether to invert the behavior of evaling.\nDefault behavior when inserting is to NOT eval the form and only eval with\na prefix.  This allows to invert this so that default behavior is to insert\nand eval and the prefix is required to prevent evaluation.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.18.0\"))\n\n(defun cider-insert-in-repl (form eval)\n  \"Insert FORM in the REPL buffer and switch to it.\nIf EVAL is non-nil the form will also be evaluated.  Use\n`cider-invert-insert-eval-p' to invert this behavior.\"\n  (while (string-match \"\\\\`[ \\t\\n\\r]+\\\\|[ \\t\\n\\r]+\\\\'\" form)\n    (setq form (replace-match \"\" t t form)))\n  (when cider-switch-to-repl-on-insert\n    (cider-switch-to-repl-buffer))\n  (let ((repl (cider-current-repl)))\n    (with-selected-window (or (get-buffer-window repl)\n                              (selected-window))\n      (with-current-buffer repl\n        (goto-char (point-max))\n        (let ((beg (point)))\n          (insert form)\n          (indent-region beg (point))\n          (font-lock-ensure beg (point)))\n        (when (if cider-invert-insert-eval-p\n                  (not eval)\n                eval)\n          (cider-repl-return))\n        (goto-char (point-max))))))\n\n(defun cider-insert-last-sexp-in-repl (&optional arg)\n  \"Insert the expression preceding point in the REPL buffer.\nIf invoked with a prefix ARG eval the expression after inserting it.\"\n  (interactive \"P\")\n  (cider-insert-in-repl (cider-last-sexp) arg))\n\n(defun cider-insert-defun-in-repl (&optional arg)\n  \"Insert the top level form at point in the REPL buffer.\nIf invoked with a prefix ARG eval the expression after inserting it.\"\n  (interactive \"P\")\n  (cider-insert-in-repl (cider-defun-at-point) arg))\n\n(defun cider-insert-region-in-repl (start end &optional arg)\n  \"Insert the current region in the REPL buffer.\nSTART and END represent the region's boundaries.\nIf invoked with a prefix ARG eval the expression after inserting it.\"\n  (interactive \"rP\")\n  (cider-insert-in-repl\n   (buffer-substring-no-properties start end) arg))\n\n(defun cider-insert-ns-form-in-repl (&optional arg)\n  \"Insert the current buffer's ns form in the REPL buffer.\nIf invoked with a prefix ARG eval the expression after inserting it.\"\n  (interactive \"P\")\n  (cider-insert-in-repl (cider-ns-form) arg))\n\n\n\f\n;;; The menu-bar\n(defconst cider-mode-menu\n  `(\"CIDER\"\n    [\"Start or connect to any REPL\" cider\n     :help \"A simple wrapper around all commands for starting/connecting to a REPL.\"]\n    (\"Clojure\"\n     [\"Start a Clojure REPL\" cider-jack-in\n      :help \"Starts an nREPL server and connects a Clojure REPL to it.\"]\n     [\"Connect to a Clojure REPL\" cider-connect\n      :help \"Connects to a REPL that's already running.\"])\n    (\"ClojureScript\"\n     [\"Start a ClojureScript REPL\" cider-jack-in-cljs\n      :help \"Starts an nREPL server and connects a ClojureScript REPL to it.\"]\n     [\"Connect to a ClojureScript REPL\" cider-connect-clojurescript\n      :help \"Connects to a ClojureScript REPL that's already running.\"]\n     [\"Create a ClojureScript REPL from a Clojure REPL\" cider-jack-in-sibling-clojurescript])\n    \"--\"\n    [\"Quit\" cider-quit :active (cider-connected-p)]\n    [\"Restart\" cider-restart :active (cider-connected-p)]\n    \"--\"\n    [\"Connection info\" cider-describe-connection\n     :active (cider-connected-p)]\n    [\"Select any CIDER buffer\" cider-selector]\n    \"--\"\n    [\"Configure CIDER\" (customize-group 'cider)]\n    \"--\"\n    [\"A sip of CIDER\" cider-drink-a-sip]\n    [\"View user manual\" cider-view-manual]\n    [\"View quick reference card\" cider-view-refcard]\n    [\"Report a bug\" cider-report-bug]\n    [\"Version info\" cider-version]\n    \"--\"\n    [\"Close ancillary buffers\" cider-close-ancillary-buffers\n     :active (seq-remove #'null cider-ancillary-buffers)]\n    (\"nREPL\" :active (cider-connected-p)\n     [\"List nREPL middleware\" cider-list-nrepl-middleware]\n     [\"Describe nREPL session\" cider-describe-nrepl-session]\n     [\"Toggle message logging\" nrepl-toggle-message-logging]))\n  \"Menu for CIDER mode.\")\n\n(defconst cider-mode-eval-menu\n  '(\"CIDER Eval\" :visible (cider-connected-p)\n    [\"Eval top-level sexp\" cider-eval-defun-at-point]\n    [\"Eval top-level sexp to point\" cider-eval-defun-up-to-point]\n    [\"Eval top-level sexp to comment\" cider-eval-defun-to-comment]\n    [\"Eval top-level sexp and pretty-print to comment\" cider-pprint-eval-defun-to-comment]\n    \"--\"\n    [\"Eval current list\" cider-eval-list-at-point]\n    [\"Eval current sexp\" cider-eval-sexp-at-point]\n    [\"Eval and tap current sexp\" cider-tap-sexp-at-point]\n    [\"Eval current sexp to point\" cider-eval-sexp-up-to-point]\n    [\"Eval current sexp in context\" cider-eval-sexp-at-point-in-context]\n    \"--\"\n    [\"Eval last sexp\" cider-eval-last-sexp]\n    [\"Eval and tap last sexp\" cider-tap-last-sexp]\n    [\"Eval last sexp in context\" cider-eval-last-sexp-in-context]\n    [\"Eval last sexp and insert\" cider-eval-print-last-sexp\n     :keys \"\\\\[universal-argument] \\\\[cider-eval-last-sexp]\"]\n    [\"Eval last sexp in popup buffer\" cider-pprint-eval-last-sexp]\n    [\"Eval last sexp and replace\" cider-eval-last-sexp-and-replace]\n    [\"Eval last sexp to REPL\" cider-eval-last-sexp-to-repl]\n    [\"Eval last sexp and pretty-print to REPL\" cider-pprint-eval-last-sexp-to-repl]\n    [\"Eval last sexp and pretty-print to comment\" cider-pprint-eval-last-sexp-to-comment]\n    \"--\"\n    [\"Eval selected region\" cider-eval-region]\n    [\"Eval ns form\" cider-eval-ns-form]\n    \"--\"\n    [\"Interrupt evaluation\" cider-interrupt]\n    \"--\"\n    [\"Insert last sexp in REPL\" cider-insert-last-sexp-in-repl]\n    [\"Insert last sexp in REPL and eval\" (cider-insert-last-sexp-in-repl t)\n     :keys \"\\\\[universal-argument] \\\\[cider-insert-last-sexp-in-repl]\"]\n    [\"Insert top-level sexp in REPL\" cider-insert-defun-in-repl]\n    [\"Insert region in REPL\" cider-insert-region-in-repl]\n    [\"Insert ns form in REPL\" cider-insert-ns-form-in-repl]\n    \"--\"\n    [\"Load this buffer\" cider-load-buffer]\n    [\"Load this buffer and switch to REPL\" cider-load-buffer-and-switch-to-repl-buffer]\n    [\"Load another file\" cider-load-file]\n    [\"Recursively load all files in directory\" cider-load-all-files]\n    [\"Load all project files\" cider-load-all-project-ns]\n    [\"Refresh loaded code\" cider-ns-refresh]\n    [\"Require and reload\" cider-ns-reload]\n    [\"Require and reload all\" cider-ns-reload-all]\n    [\"Run project (-main function)\" cider-run])\n  \"Menu for CIDER mode eval commands.\")\n\n(defconst cider-mode-interactions-menu\n  `(\"CIDER Interactions\" :visible (cider-connected-p)\n    [\"Complete symbol\" complete-symbol]\n    \"--\"\n    (\"REPL\"\n     [\"Set REPL to this ns\" cider-repl-set-ns]\n     [\"Switch to REPL\" cider-switch-to-repl-buffer]\n     [\"REPL Pretty Print\" cider-repl-toggle-pretty-printing\n      :style toggle :selected cider-repl-use-pretty-printing]\n     [\"Clear latest output\" cider-find-and-clear-repl-output]\n     [\"Clear all output\" (cider-find-and-clear-repl-output t)\n      :keys \"\\\\[universal-argument] \\\\[cider-find-and-clear-repl-output]\"]\n     \"--\"\n     [\"Configure the REPL\" (customize-group 'cider-repl)])\n    ,cider-doc-menu\n    (\"Find (jump to)\"\n     [\"Find definition\" cider-find-var]\n     [\"Find namespace\" cider-find-ns]\n     [\"Find resource\" cider-find-resource]\n     [\"Find keyword\" cider-find-keyword]\n     [\"Go back\" cider-pop-back])\n    (\"Xref\"\n     [\"Find fn references\" cider-xref-fn-refs]\n     [\"Find fn references and select\" cider-xref-fn-refs-select]\n     [\"Find fn dependencies\" cider-xref-fn-defs]\n     [\"Find fn dependencies and select\" cider-xref-fn-defs-select])\n    (\"Browse\"\n     [\"Browse namespace\" cider-browse-ns]\n     [\"Browse all namespaces\" cider-browse-ns-all]\n     [\"Browse spec\" cider-browse-spec]\n     [\"Browse all specs\" cider-browse-spec-all]\n     [\"Browse REPL input history\" cider-repl-history]\n     [\"Browse classpath\" cider-classpath]\n     [\"Browse classpath entry\" cider-open-classpath-entry])\n    (\"Format\"\n     [\"Format EDN last sexp\" cider-format-edn-last-sexp]\n     [\"Format EDN region\" cider-format-edn-region]\n     [\"Format EDN buffer\" cider-format-edn-buffer])\n    (\"Macroexpand\"\n     [\"Macroexpand-1\" cider-macroexpand-1]\n     [\"Macroexpand-all\" cider-macroexpand-all])\n    ,cider-test-menu\n    (\"Debug\"\n     [\"Inspect\" cider-inspect]\n     [\"Toggle var tracing\" cider-toggle-trace-var]\n     [\"Toggle ns tracing\" cider-toggle-trace-ns]\n     \"--\"\n     [\"Debug top-level form\" cider-debug-defun-at-point\n      :keys \"\\\\[universal-argument] \\\\[cider-eval-defun-at-point]\"]\n     [\"List instrumented defs\" cider-browse-instrumented-defs]\n     \"--\"\n     [\"Configure the Debugger\" (customize-group 'cider-debug)])\n    ,cider-profile-menu\n    (\"Misc\"\n     [\"Clojure Cheatsheet\" cider-cheatsheet]\n     [\"Flush completion cache\" cider-completion-flush-caches]))\n  \"Menu for CIDER interactions.\")\n\n\n(declare-function cider-ns-refresh \"cider-ns\")\n(declare-function cider-ns-reload \"cider-ns\")\n(declare-function cider-ns-reload-all \"cider-ns\")\n(declare-function cider-browse-ns \"cider-browse-ns\")\n(declare-function cider-eval-ns-form \"cider-eval\")\n(declare-function cider-repl-set-ns \"cider-repl\")\n(declare-function cider-find-ns \"cider-find\")\n\n(defvar cider-ns-map\n  (let ((map (define-prefix-command 'cider-ns-map)))\n    (define-key map (kbd \"b\") #'cider-browse-ns)\n    (define-key map (kbd \"M-b\") #'cider-browse-ns)\n    (define-key map (kbd \"e\") #'cider-eval-ns-form)\n    (define-key map (kbd \"M-e\") #'cider-eval-ns-form)\n    (define-key map (kbd \"f\") #'cider-find-ns)\n    (define-key map (kbd \"M-f\") #'cider-find-ns)\n    (define-key map (kbd \"n\") #'cider-repl-set-ns)\n    (define-key map (kbd \"M-n\") #'cider-repl-set-ns)\n    (define-key map (kbd \"r\") #'cider-ns-refresh)\n    (define-key map (kbd \"M-r\") #'cider-ns-refresh)\n    (define-key map (kbd \"l\") #'cider-ns-reload)\n    (define-key map (kbd \"M-l\") #'cider-ns-reload-all)\n    map)\n  \"CIDER NS keymap.\")\n\n;; Those declares are needed, because we autoload all those commands when first\n;; used. That optimizes CIDER's initial load time.\n(declare-function cider-macroexpand-1 \"cider-macroexpansion\")\n(declare-function cider-macroexpand-all \"cider-macroexpansion\")\n(declare-function cider-selector \"cider-selector\")\n(declare-function cider-toggle-trace-ns \"cider-tracing\")\n(declare-function cider-toggle-trace-var \"cider-tracing\")\n(declare-function cider-find-resource \"cider-find\")\n(declare-function cider-find-keyword \"cider-find\")\n(declare-function cider-find-var \"cider-find\")\n(declare-function cider-find-dwim-at-mouse \"cider-find\")\n(declare-function cider-xref-fn-refs \"cider-xref\")\n(declare-function cider-xref-fn-refs-select \"cider-xref\")\n(declare-function cider-xref-fn-deps \"cider-xref\")\n(declare-function cider-xref-fn-deps-select \"cider-xref\")\n\n(defconst cider--has-many-mouse-buttons (not (memq window-system '(mac ns)))\n  \"Non-nil if system binds forward and back buttons to  and .\n\nAs it stands Emacs fires these events on  and  on 'x' and\n'w32'systems while on macOS it presents them on  and .\")\n\n(defcustom cider-use-xref t\n  \"Enable xref integration.\"\n  :type 'boolean\n  :safe #'booleanp\n  :group 'cider\n  :version '(cider . \"1.2.0\"))\n\n(defcustom cider-xref-fn-depth -90\n  \"The depth to use when adding the CIDER xref function to the relevant hook.\nBy convention this is a number between -100 and 100, lower numbers indicating a\nhigher precedence.\"\n  :type 'integer\n  :group 'cider\n  :version '(cider . \"1.2.0\"))\n\n(defconst cider-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"C-c C-d\") 'cider-doc-map)\n    (unless cider-use-xref\n      (define-key map (kbd \"M-.\") #'cider-find-var)\n      (define-key map (kbd \"M-,\") #'cider-pop-back))\n    (define-key map (kbd (if cider--has-many-mouse-buttons \"\" \"\")) #'xref-pop-marker-stack)\n    (define-key map (kbd (if cider--has-many-mouse-buttons \"\" \"\")) #'cider-find-dwim-at-mouse)\n    (define-key map (kbd \"C-c C-.\") #'cider-find-ns)\n    (define-key map (kbd \"C-c C-:\") #'cider-find-keyword)\n    (define-key map (kbd \"C-c M-.\") #'cider-find-resource)\n    (define-key map (kbd \"M-TAB\") #'complete-symbol)\n    (define-key map (kbd \"C-M-x\")   #'cider-eval-defun-at-point)\n    (define-key map (kbd \"C-c C-c\") #'cider-eval-defun-at-point)\n    (define-key map (kbd \"C-x C-e\") #'cider-eval-last-sexp)\n    (define-key map (kbd \"C-c C-e\") #'cider-eval-last-sexp)\n    (define-key map (kbd \"C-c C-p\") #'cider-pprint-eval-last-sexp)\n    (define-key map (kbd \"C-c C-f\") #'cider-pprint-eval-defun-at-point)\n    (define-key map (kbd \"C-c C-v\") 'cider-eval-commands-map)\n    (define-key map (kbd \"C-c C-j\") 'cider-insert-commands-map)\n    (define-key map (kbd \"C-c M-;\") #'cider-eval-defun-to-comment)\n    (define-key map (kbd \"C-c M-e\") #'cider-eval-last-sexp-to-repl)\n    (define-key map (kbd \"C-c M-p\") #'cider-insert-last-sexp-in-repl)\n    (define-key map (kbd \"C-c M-:\") #'cider-read-and-eval)\n    (define-key map (kbd \"C-c C-u\") #'cider-undef)\n    (define-key map (kbd \"C-c C-M-u\") #'cider-undef-all)\n    (define-key map (kbd \"C-c C-m\") #'cider-macroexpand-1)\n    (define-key map (kbd \"C-c M-m\") #'cider-macroexpand-all)\n    (define-key map (kbd \"C-c M-n\") 'cider-ns-map)\n    (define-key map (kbd \"C-c M-i\") #'cider-inspect)\n    (define-key map (kbd \"C-c M-t v\") #'cider-toggle-trace-var)\n    (define-key map (kbd \"C-c M-t n\") #'cider-toggle-trace-ns)\n    (define-key map (kbd \"C-c C-z\") #'cider-switch-to-repl-buffer)\n    (define-key map (kbd \"C-c M-z\") #'cider-load-buffer-and-switch-to-repl-buffer)\n    (define-key map (kbd \"C-c C-o\") #'cider-find-and-clear-repl-output)\n    (define-key map (kbd \"C-c C-k\") #'cider-load-buffer)\n    (define-key map (kbd \"C-c C-l\") #'cider-load-file)\n    (define-key map (kbd \"C-c C-M-l\") #'cider-load-all-files)\n    (define-key map (kbd \"C-c C-b\") #'cider-interrupt)\n    (define-key map (kbd \"C-c ,\")   'cider-test-commands-map)\n    (define-key map (kbd \"C-c C-t\") 'cider-test-commands-map)\n    (define-key map (kbd \"C-c M-s\") #'cider-selector)\n    (define-key map (kbd \"C-c M-d\") #'cider-describe-connection)\n    (define-key map (kbd \"C-c C-=\") 'cider-profile-map)\n    (define-key map (kbd \"C-c C-? r\") #'cider-xref-fn-refs)\n    (define-key map (kbd \"C-c C-? C-r\") #'cider-xref-fn-refs-select)\n    (define-key map (kbd \"C-c C-? d\") #'cider-xref-fn-deps)\n    (define-key map (kbd \"C-c C-? C-d\") #'cider-xref-fn-deps-select)\n    (define-key map (kbd \"C-c C-q\") #'cider-quit)\n    (define-key map (kbd \"C-c M-r\") #'cider-restart)\n    (dolist (variable '(cider-mode-interactions-menu\n                        cider-mode-eval-menu\n                        cider-mode-menu))\n      (easy-menu-do-define (intern (format \"%s-open\" variable))\n                           map\n                           (get variable 'variable-documentation)\n                           (cider--menu-add-help-strings (symbol-value variable))))\n    map))\n\n;; This menu works as an easy entry-point into CIDER.  Even if cider.el isn't\n;; loaded yet, this will be shown in Clojure buffers next to the \"Clojure\"\n;; menu.\n;;;###autoload\n(with-eval-after-load 'clojure-mode\n  (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map\n    \"Menu for Clojure mode.\n  This is displayed in `clojure-mode' buffers, if `cider-mode' is not active.\"\n    `(\"CIDER\" :visible (not cider-mode)\n      [\"Start a Clojure REPL\" cider-jack-in-clj\n       :help \"Starts an nREPL server and connects a Clojure REPL to it.\"]\n      [\"Connect to a Clojure REPL\" cider-connect-clj\n       :help \"Connects to a REPL that's already running.\"]\n      [\"Start a ClojureScript REPL\" cider-jack-in-cljs\n       :help \"Starts an nREPL server and connects a ClojureScript REPL to it.\"]\n      [\"Connect to a ClojureScript REPL\" cider-connect-cljs\n       :help \"Connects to a ClojureScript REPL that's already running.\"]\n      [\"Start a Clojure REPL, and a ClojureScript REPL\" cider-jack-in-clj&cljs\n       :help \"Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.\"]\n      \"--\"\n      [\"View user manual\" cider-view-manual])))\n\n;;; Dynamic indentation\n(defcustom cider-dynamic-indentation t\n  \"Whether CIDER should aid Clojure(Script) indentation.\nIf non-nil, CIDER uses runtime information (such as the \\\":style/indent\\\"\nmetadata) to improve standard `clojure-mode' indentation.\nIf nil, CIDER won't interfere with `clojure-mode's indentation.\n\nToggling this variable only takes effect after a file is closed and\nre-visited.\"\n  :type 'boolean\n  :package-version '(cider . \"0.11.0\")\n  :group 'cider)\n\n(defun cider--get-symbol-indent (symbol-name)\n  \"Return the indent metadata for SYMBOL-NAME in the current namespace.\"\n  (let* ((ns (let ((clojure-cache-ns t)) ; we force ns caching here for performance reasons\n               ;; silence bytecode warning of unused lexical var\n               (ignore clojure-cache-ns)\n               (cider-current-ns))))\n    (if-let* ((meta (cider-resolve-var ns symbol-name))\n              (indent (or (nrepl-dict-get meta \"style/indent\")\n                          (nrepl-dict-get meta \"indent\"))))\n        (let ((format (format \":indent metadata on ‘%s’ is unreadable! \\nERROR: %%s\"\n                              symbol-name)))\n          (with-demoted-errors format\n            (cider--deep-vector-to-list (read indent))))\n      ;; There's no indent metadata, but there might be a clojure-mode\n      ;; indent-spec with fully-qualified namespace.\n      (when (string-match cider-resolve--prefix-regexp symbol-name)\n        (when-let* ((sym (intern-soft (replace-match (save-match-data\n                                                       (cider-resolve-alias ns (match-string 1 symbol-name)))\n                                                     t t symbol-name 1))))\n          (get sym 'clojure-indent-function))))))\n\n\f\n;;; Dynamic font locking\n(defcustom cider-font-lock-dynamically '(macro core deprecated)\n  \"Specifies how much dynamic font-locking CIDER should use.\nDynamic font-locking this refers to applying syntax highlighting to vars\ndefined in the currently active nREPL connection.  This is done in addition\nto `clojure-mode's usual (static) font-lock, so even if you set this\nvariable to nil you'll still see basic syntax highlighting.\n\nThe value is a list of symbols, each one indicates a different type of var\nthat should be font-locked:\n   `macro' (default): Any defined macro gets the `font-lock-keyword-face'.\n   `function': Any defined function gets the `font-lock-function-face'.\n   `var': Any non-local var gets the `font-lock-variable-name-face'.\n   `deprecated' (default): Any deprecated var gets the `cider-deprecated-face'\n   face.\n   `core' (default): Any symbol from clojure.core (face depends on type).\n\nThe value can also be t, which means to font-lock as much as possible.\"\n  :type '(choice (set :tag \"Fine-tune font-locking\"\n                      (const :tag \"Any defined macro\" macro)\n                      (const :tag \"Any defined function\" function)\n                      (const :tag \"Any defined var\" var)\n                      (const :tag \"Any defined deprecated\" deprecated)\n                      (const :tag \"Any symbol from clojure.core\" core))\n                 (const :tag \"Font-lock as much as possible\" t))\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-font-lock-reader-conditionals t\n  \"Apply font-locking to unused reader conditional expressions.\nThe result depends on the buffer CIDER connection type.\"\n  :type 'boolean\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defface cider-deprecated-face\n  '((((background light)) :background \"light goldenrod\")\n    (((background dark)) :background \"#432\"))\n  \"Face used on deprecated vars.\"\n  :group 'cider)\n\n(defface cider-instrumented-face\n  '((((type graphic)) :box (:color \"#c00\" :line-width -1))\n    (t :underline t :background \"#800\"))\n  \"Face used to mark code being debugged.\"\n  :group 'cider-debug\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defface cider-traced-face\n  '((((type graphic)) :box (:color \"cyan\" :line-width -1))\n    (t :underline t :background \"#066\"))\n  \"Face used to mark code being traced.\"\n  :group 'cider\n  :package-version '(cider . \"0.11.0\"))\n\n(defface cider-reader-conditional-face\n  '((t (:inherit font-lock-comment-face)))\n  \"Face used to mark unused reader conditional expressions.\"\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defconst cider-reader-conditionals-regexp \"\\\\(?:#\\\\?@?[[:space:]\\n]*(\\\\)\"\n  \"Regexp for matching reader conditionals with a non-capturing group.\nStarts from the reader macro characters to the opening parentheses.\")\n\n(defvar cider--reader-conditionals-match-data (list nil nil)\n  \"Reusable list for `match-data` in reader conditionals font lock matchers.\")\n\n(defun cider--search-reader-conditionals (limit)\n  \"Matcher for finding reader conditionals.\nSearch is done with the given LIMIT.\"\n  (when (and cider-font-lock-reader-conditionals\n             (cider-connected-p))\n    (when (search-forward-regexp cider-reader-conditionals-regexp limit t)\n      (let ((start (match-beginning 0))\n            (state (syntax-ppss)))\n        (if (or (nth 3 state) (nth 4 state)) ; inside string or comment?\n            (cider--search-reader-conditionals limit)\n          (when (<= (point) limit)\n            (ignore-errors\n              (let ((md (match-data nil cider--reader-conditionals-match-data)))\n                (setf (nth 0 md) start)\n                (setf (nth 1 md) (point))\n                (set-match-data md)\n                t))))))))\n\n(defun cider--anchored-search-suppressed-forms-internal (repl-types limit)\n  \"Helper function for `cider--anchored-search-suppressed-forms`.\nREPL-TYPES is a list of strings repl-type strings.  LIMIT is the same as\nthe LIMIT in `cider--anchored-search-suppressed-forms`\"\n  (when (= (length repl-types) 1)\n    (let ((type (car repl-types))\n          (expr (read (current-buffer)))\n          (start (save-excursion (backward-sexp) (point))))\n      (when (<= (point) limit)\n        (forward-sexp)\n        (if (not (string-equal (symbol-name expr) (concat \":\" type)))\n            (ignore-errors\n              (cl-assert (<= (point) limit))\n              (let ((md (match-data nil cider--reader-conditionals-match-data)))\n                (setf (nth 0 md) start)\n                (setf (nth 1 md) (point))\n                (set-match-data md)\n                t))\n          (cider--anchored-search-suppressed-forms-internal repl-types limit))))))\n\n(defun cider--anchored-search-suppressed-forms (limit)\n  \"Matcher for finding unused reader conditional expressions.\nAn unused reader conditional expression is an expression for a platform\nthat does not match the CIDER connection for the buffer.  Search is done\nwith the given LIMIT.\"\n  (let ((repl-types (seq-uniq (seq-map\n                               (lambda (repl)\n                                 (symbol-name (cider-repl-type repl)))\n                               (cider-repls))))\n        (result 'retry))\n    (while (and (eq result 'retry) (<= (point) limit))\n      (condition-case condition\n          (setq result\n                (cider--anchored-search-suppressed-forms-internal\n                 repl-types limit))\n        (invalid-read-syntax\n         (setq result 'retry))\n        (wrong-type-argument\n         (setq result 'retry))\n        (scan-error\n         (setq result 'retry))\n        (end-of-file\n         (setq result nil))\n        (error\n         (setq result nil)\n         (message\n          \"Error during fontification while searching for forms: %S\"\n          condition))))\n    (if (eq result 'retry) (setq result nil))\n    result))\n\n(defconst cider--reader-conditionals-font-lock-keywords\n  '((cider--search-reader-conditionals\n     (cider--anchored-search-suppressed-forms\n      (save-excursion\n        (let* ((state (syntax-ppss))\n               (list-pt (nth 1 state)))\n          (when list-pt\n            (goto-char list-pt)\n            (forward-list)\n            (backward-char)\n            (point))))\n      nil\n      (0 'cider-reader-conditional-face t))))\n  \"Font Lock keywords for unused reader conditionals in CIDER mode.\")\n\n(defun cider--unless-local-match (value)\n  \"Return VALUE, unless `match-string' is a local var.\"\n  (unless (or (get-text-property (point) 'cider-block-dynamic-font-lock)\n              (member (match-string 0)\n                      (get-text-property (point) 'cider-locals)))\n    value))\n\n(defun cider--compile-font-lock-keywords (symbols-plist core-plist)\n  \"Return a list of font-lock rules for symbols in SYMBOLS-PLIST, CORE-PLIST.\"\n  (let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t)\n                                         '(function var macro core deprecated)\n                                       cider-font-lock-dynamically))\n        deprecated enlightened\n        macros functions vars instrumented traced)\n    (cl-labels ((handle-plist\n                 (plist)\n                 (let ((do-function (memq 'function cider-font-lock-dynamically))\n                       (do-var (memq 'var cider-font-lock-dynamically))\n                       (do-macro (memq 'macro cider-font-lock-dynamically))\n                       (do-deprecated (memq 'deprecated cider-font-lock-dynamically)))\n                   (while plist\n                     (let ((sym (pop plist))\n                           (meta (pop plist)))\n                       (pcase (nrepl-dict-get meta \"cider/instrumented\")\n                         (`nil nil)\n                         (`\"\\\"breakpoint-if-interesting\\\"\"\n                          (push sym instrumented))\n                         (`\"\\\"light-form\\\"\"\n                          (push sym enlightened)))\n                       ;; The ::traced keywords can be inlined by MrAnderson, so\n                       ;; we catch that case too.\n                       ;; FIXME: This matches values too, not just keys.\n                       (when (seq-find (lambda (k) (and (stringp k)\n                                                        (string-match (rx \"clojure.tools.trace/traced\" eos) k)))\n                                       meta)\n                         (push sym traced))\n                       (when (and do-deprecated (nrepl-dict-get meta \"deprecated\"))\n                         (push sym deprecated))\n                       (let ((is-macro (nrepl-dict-get meta \"macro\"))\n                             (is-function (or (nrepl-dict-get meta \"fn\")\n                                              (nrepl-dict-get meta \"arglists\"))))\n                         (cond ((and do-macro is-macro)\n                                (push sym macros))\n                               ((and do-function is-function)\n                                (push sym functions))\n                               ((and do-var (not is-function) (not is-macro))\n                                (push sym vars)))))))))\n      (when (memq 'core cider-font-lock-dynamically)\n        (let ((cider-font-lock-dynamically '(function var macro core deprecated)))\n          (handle-plist core-plist)))\n      (handle-plist symbols-plist))\n    `(\n      ,@(when macros\n          `((,(concat (rx (or \"(\" \"#'\")) ; Can't take the value of macros.\n                      \"\\\\(\" (regexp-opt macros 'symbols) \"\\\\)\")\n             1 (cider--unless-local-match font-lock-keyword-face))))\n      ,@(when functions\n          `((,(regexp-opt functions 'symbols) 0\n             (cider--unless-local-match font-lock-function-name-face))))\n      ,@(when vars\n          `((,(regexp-opt vars 'symbols) 0\n             (cider--unless-local-match font-lock-variable-name-face))))\n      ,@(when deprecated\n          `((,(regexp-opt deprecated 'symbols) 0\n             (cider--unless-local-match 'cider-deprecated-face) append)))\n      ,@(when enlightened\n          `((,(regexp-opt enlightened 'symbols) 0\n             (cider--unless-local-match 'cider-enlightened-face) append)))\n      ,@(when instrumented\n          `((,(regexp-opt instrumented 'symbols) 0\n             (cider--unless-local-match 'cider-instrumented-face) append)))\n      ,@(when traced\n          `((,(regexp-opt traced 'symbols) 0\n             (cider--unless-local-match 'cider-traced-face) append))))))\n\n(defconst cider--static-font-lock-keywords\n  (eval-when-compile\n    `((,(regexp-opt '(\"#break\" \"#dbg\" \"#light\") 'symbols) 0 font-lock-warning-face)))\n  \"Default expressions to highlight in CIDER mode.\")\n\n(defvar-local cider--dynamic-font-lock-keywords nil)\n\n(defun cider-refresh-dynamic-font-lock (&optional ns)\n  \"Ensure that the current buffer has up-to-date font-lock rules.\nNS defaults to `cider-current-ns', and it can also be a dict describing the\nnamespace itself.\"\n  (interactive)\n  (when (and cider-font-lock-dynamically\n             font-lock-mode)\n    (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)\n    (when-let* ((ns (or ns (cider-current-ns)))\n                (symbols (cider-resolve-ns-symbols ns)))\n      (setq-local cider--dynamic-font-lock-keywords\n                  (cider--compile-font-lock-keywords\n                   symbols (cider-resolve-ns-symbols (cider-resolve-core-ns))))\n      (font-lock-add-keywords nil cider--dynamic-font-lock-keywords 'end))\n    (font-lock-flush)))\n\n\f\n;;; Detecting local variables\n(defun cider--read-locals-from-next-sexp ()\n  \"Return a list of all locals inside the next logical sexp.\"\n  (save-excursion\n    (ignore-errors\n      (clojure-forward-logical-sexp 1)\n      (let ((out nil)\n            (end (point)))\n        (forward-sexp -1)\n        ;; FIXME: This returns locals found inside the :or clause of a\n        ;; destructuring map.\n        (while (search-forward-regexp \"\\\\_<[^:&]\\\\(\\\\sw\\\\|\\\\s_\\\\)*\\\\_>\" end 'noerror)\n          (push (match-string-no-properties 0) out))\n        out))))\n\n(defun cider--read-locals-from-bindings-vector ()\n  \"Return a list of all locals inside the next bindings vector.\"\n  (save-excursion\n    (ignore-errors\n      (cider-start-of-next-sexp)\n      (when (eq (char-after) ?\\[)\n        (forward-char 1)\n        (let ((out nil))\n          (setq out (append (cider--read-locals-from-next-sexp) out))\n          (while (ignore-errors (clojure-forward-logical-sexp 3)\n                                (unless (eobp)\n                                  (forward-sexp -1)\n                                  t))\n            (setq out (append (cider--read-locals-from-next-sexp) out)))\n          out)))))\n\n(defun cider--read-locals-from-arglist ()\n  \"Return a list of all locals in current form's arglist(s).\"\n  (let ((out nil))\n    (save-excursion\n      (ignore-errors\n        (cider-start-of-next-sexp)\n        ;; Named fn\n        (when (looking-at-p \"\\\\s_\\\\|\\\\sw\")\n          (cider-start-of-next-sexp 1))\n        ;; Docstring\n        (when (eq (char-after) ?\\\")\n          (cider-start-of-next-sexp 1))\n        ;; Attribute map\n        (when (eq (char-after) ?{)\n          (cider-start-of-next-sexp 1))\n        ;; The arglist\n        (pcase (char-after)\n          (?\\[ (setq out (cider--read-locals-from-next-sexp)))\n          ;; FIXME: This returns false positives. It takes all arglists of a\n          ;; function and returns all args it finds. The logic should be changed\n          ;; so that each arglist applies to its own scope.\n          (?\\( (ignore-errors\n                 (while (eq (char-after) ?\\()\n                   (save-excursion\n                     (forward-char 1)\n                     (setq out (append (cider--read-locals-from-next-sexp) out)))\n                   (cider-start-of-next-sexp 1)))))))\n    out))\n\n(defun cider--parse-and-apply-locals (end &optional outer-locals)\n  \"Figure out local variables between point and END.\nA list of these variables is set as the `cider-locals' text property over\nthe code where they are in scope.\nOptional argument OUTER-LOCALS is used to specify local variables defined\nbefore point.\"\n  (while (search-forward-regexp \"(\\\\(ns\\\\_>\\\\|def\\\\|fn\\\\|for\\\\b\\\\|loop\\\\b\\\\|with-\\\\|do[a-z]+\\\\|\\\\([a-z]+-\\\\)?let\\\\b\\\\)\"\n                                end 'noerror)\n    (goto-char (match-beginning 0))\n    (let ((sym (match-string 1))\n          (sexp-end (save-excursion\n                      (or (ignore-errors (forward-sexp 1)\n                                         (point))\n                          end))))\n      ;; #1324: Don't do dynamic font-lock in `ns' forms, they are special\n      ;; macros where nothing is evaluated, so we'd get a lot of false\n      ;; positives.\n      (if (equal sym \"ns\")\n          (add-text-properties (point) sexp-end '(cider-block-dynamic-font-lock t))\n        (forward-char 1)\n        (forward-sexp 1)\n        (let ((locals (append outer-locals\n                              (pcase sym\n                                ((or \"fn\" \"def\" \"\") (cider--read-locals-from-arglist))\n                                (_ (cider--read-locals-from-bindings-vector))))))\n          (add-text-properties (point) sexp-end (list 'cider-locals locals))\n          (clojure-forward-logical-sexp 1)\n          (cider--parse-and-apply-locals sexp-end locals)))\n      (goto-char sexp-end))))\n\n(defun cider--update-locals-for-region (beg end)\n  \"Update the `cider-locals' text property for region from BEG to END.\"\n  (save-excursion\n    (goto-char beg)\n    ;; If the inside of a `ns' form changed, reparse it from the start.\n    (when (and (not (bobp))\n               (get-text-property (1- (point)) 'cider-block-dynamic-font-lock))\n      (ignore-errors (beginning-of-defun)))\n    (save-excursion\n      ;; Move up until we reach a sexp that encloses the entire region (or\n      ;; a top-level sexp), and set that as the new BEG.\n      (goto-char end)\n      (while (and (or (> (point) beg)\n                      (not (eq (char-after) ?\\()))\n                  (condition-case nil\n                      (progn (backward-up-list) t)\n                    (scan-error nil))))\n      (setq beg (min beg (point)))\n      ;; If there are locals above the current sexp, reapply them to the\n      ;; current sexp.\n      (let ((locals-above (when (> beg (point-min))\n                            (get-text-property (1- beg) 'cider-locals))))\n        (condition-case nil\n            (clojure-forward-logical-sexp 1)\n          (error (goto-char end)))\n        (add-text-properties beg (point) `(cider-locals ,locals-above))\n        ;; Extend the region being font-locked to include whole sexps.\n        (setq end (max end (point)))\n        (goto-char beg)\n        (ignore-errors\n          (cider--parse-and-apply-locals end locals-above))))))\n\n(defun cider--docview-as-string (sym info)\n  \"Return a string of what would be displayed by `cider-docview-render'.\nSYM and INFO is passed to `cider-docview-render'\"\n  (with-temp-buffer\n    (cider-docview-render (current-buffer) sym info)\n    (goto-char (point-max))\n    (forward-line -1)\n    (replace-regexp-in-string\n     \"[`']\" \"\\\\\\\\=\\\\&\"\n     (buffer-substring-no-properties (point-min) (1- (point))))))\n\n(defcustom cider-use-tooltips t\n  \"If non-nil, CIDER displays mouse-over tooltips.\nIt does this as well as the `help-echo' mechanism.\"\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider \"0.12.0\"))\n\n(defvar cider--debug-mode-response)\n(defvar cider--debug-mode)\n\n(defun cider--help-echo (_ obj pos)\n  \"Return the help-echo string for OBJ at POS.\nSee \\(info \\\"(elisp) Special Properties\\\")\"\n  (while-no-input\n    (when (and (bufferp obj)\n               (cider-connected-p)\n               cider-use-tooltips\n               (not (eq help-at-pt-display-when-idle t)))\n      (with-current-buffer obj\n        (ignore-errors\n          (save-excursion\n            (goto-char pos)\n            (when-let* ((sym (cider-symbol-at-point)))\n              (if (member sym (get-text-property (point) 'cider-locals))\n                  (concat (format \"`%s' is a local\" sym)\n                          (when cider--debug-mode\n                            (let* ((locals (nrepl-dict-get cider--debug-mode-response \"locals\"))\n                                   (local-val (cadr (assoc sym locals))))\n                              (format \" with value:\\n%s\" local-val))))\n                (let* ((info (cider-sync-request:info sym))\n                       (candidates (nrepl-dict-get info \"candidates\")))\n                  (if candidates\n                      (concat \"There were ambiguities resolving this symbol:\\n\\n\"\n                              (mapconcat (lambda (x) (cider--docview-as-string sym x))\n                                         candidates\n                                         (concat \"\\n\\n\" (make-string 60 ?-) \"\\n\\n\")))\n                    (cider--docview-as-string sym info)))))))))))\n\n(defun cider--wrap-fontify-locals (func)\n  \"Return a function that will call FUNC after parsing local variables.\nThe local variables are stored in a list under the `cider-locals' text\nproperty.\"\n  (lambda (beg end &rest rest)\n    (with-silent-modifications\n      (remove-text-properties beg end '(cider-locals nil cider-block-dynamic-font-lock nil))\n      (when cider-use-tooltips\n        (add-text-properties beg end '(help-echo cider--help-echo)))\n      (when cider-font-lock-dynamically\n        (cider--update-locals-for-region beg end)))\n    (apply func beg end rest)))\n\n\f\n;;; Minor-mode definition\n(defvar x-gtk-use-system-tooltips)\n\n;;;###autoload\n(define-minor-mode cider-mode\n  \"Minor mode for REPL interaction from a Clojure buffer.\n\n\\\\{cider-mode-map}\"\n  :init-value nil\n  :lighter cider-mode-line\n  :keymap cider-mode-map\n  (if cider-mode\n      (progn\n        (setq-local sesman-system 'CIDER)\n        (cider-eldoc-setup)\n        (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t)\n        (font-lock-add-keywords nil cider--static-font-lock-keywords)\n        (cider-refresh-dynamic-font-lock)\n        (font-lock-add-keywords nil cider--reader-conditionals-font-lock-keywords)\n        ;; `font-lock-mode' might get enabled after `cider-mode'.\n        (add-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock nil 'local)\n        (setq-local font-lock-fontify-region-function\n                    (cider--wrap-fontify-locals font-lock-fontify-region-function))\n        ;; GTK tooltips look bad, and we have no control over the face.\n        (setq-local x-gtk-use-system-tooltips nil)\n        ;; `tooltip' has variable-width by default, which looks terrible.\n        (set-face-attribute 'tooltip nil :inherit 'unspecified)\n        (when cider-dynamic-indentation\n          (setq-local clojure-get-indent-function #'cider--get-symbol-indent))\n        (setq-local clojure-expected-ns-function #'cider-expected-ns)\n        (when cider-use-xref\n          (add-hook 'xref-backend-functions #'cider--xref-backend cider-xref-fn-depth 'local))\n        (setq next-error-function #'cider-jump-to-compilation-error))\n    ;; Mode cleanup\n    (mapc #'kill-local-variable '(next-error-function\n                                  x-gtk-use-system-tooltips\n                                  font-lock-fontify-region-function\n                                  clojure-get-indent-function))\n    (remove-hook 'completion-at-point-functions #'cider-complete-at-point t)\n    (when cider-use-xref\n      (remove-hook 'xref-backend-functions #'cider--xref-backend 'local))\n    (remove-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock 'local)\n    (font-lock-add-keywords nil cider--reader-conditionals-font-lock-keywords)\n    (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)\n    (font-lock-remove-keywords nil cider--static-font-lock-keywords)\n    (font-lock-flush)\n    (remove-hook 'completion-at-point-functions #'cider-complete-at-point t)))\n\n(defun cider-set-buffer-ns (ns)\n  \"Set this buffer's namespace to NS and refresh font-locking.\"\n  (setq-local cider-buffer-ns ns)\n  (when (or cider-mode (derived-mode-p 'cider-repl-mode))\n    (cider-refresh-dynamic-font-lock ns)))\n\n(provide 'cider-mode)\n\n;;; cider-mode.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-ns.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53144785,"end":53144820},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53144820},"to":{"change":3,"start":53133232,"end":53133232},"introduced_by":3}],"inode":{"change":3,"pos":53133232}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53133232},"to":{"change":3,"start":53133233,"end":53144784},"introduced_by":3}],"inode":{"change":3,"pos":53133232}},"content":[{"Del":";;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \n;;         Artur Malabarba \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Smart code refresh functionality based on ideas from:\n;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded\n;;\n;; Note that refresh with clojure.tools.namespace.repl is a smarter way to\n;; reload code: the traditional way to reload Clojure code without restarting\n;; the JVM is (require ... :reload) or an editor/IDE feature that does the same\n;; thing.\n;;\n;; This has several problems:\n;;\n;; If you modify two namespaces which depend on each other, you must remember to\n;; reload them in the correct order to avoid compilation errors.\n;;\n;; If you remove definitions from a source file and then reload it, those\n;; definitions are still available in memory.  If other code depends on those\n;; definitions, it will continue to work but will break the next time you\n;; restart the JVM.\n;;\n;; If the reloaded namespace contains defmulti, you must also reload all of the\n;; associated defmethod expressions.\n;;\n;; If the reloaded namespace contains defprotocol, you must also reload any\n;; records or types implementing that protocol and replace any existing\n;; instances of those records/types with new instances.\n;;\n;; If the reloaded namespace contains macros, you must also reload any\n;; namespaces which use those macros.\n;;\n;; If the running program contains functions which close over values in the\n;; reloaded namespace, those closed-over values are not updated (This is common\n;; in web applications which construct the \"handler stack\" as a composition of\n;; functions.)\n\n;;; Code:\n\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'cider-client)\n(require 'cider-eval)\n(require 'cider-popup)\n(require 'cider-stacktrace)\n\n(defcustom cider-ns-save-files-on-refresh 'prompt\n  \"Controls whether to prompt to save files before refreshing.\nIf nil, files are not saved.\nIf 'prompt, the user is prompted to save files if they have been modified.\nIf t, save the files without confirmation.\"\n  :type '(choice (const prompt :tag \"Prompt to save files if they have been modified\")\n                 (const nil :tag \"Don't save the files\")\n                 (const t :tag \"Save the files without confirmation\"))\n  :group 'cider\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-ns-save-files-on-refresh-modes '(clojure-mode)\n  \"Controls which files might be saved before refreshing.\nIf a list of modes, any buffers visiting files on the classpath whose major\nmode is derived from any of the modes might be saved.\nIf t, all buffers visiting files on the classpath might be saved.\"\n  :type '(choice listp\n                 (const t))\n  :group 'cider\n  :package-version '(cider . \"0.21.0\"))\n\n(defconst cider-ns-refresh-log-buffer \"*cider-ns-refresh-log*\")\n\n(defcustom cider-ns-refresh-show-log-buffer nil\n  \"Controls when to display the refresh log buffer.\nIf non-nil, the log buffer will be displayed every time `cider-ns-refresh' is\ncalled.  If nil, the log buffer will still be written to, but will never be\ndisplayed automatically.  Instead, the most relevant information will be\ndisplayed in the echo area.\"\n  :type '(choice (const :tag \"always\" t)\n                 (const :tag \"never\" nil))\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-ns-refresh-before-fn nil\n  \"Clojure function for `cider-ns-refresh' to call before reloading.\nIf nil, nothing will be invoked before reloading.  Must be a\nnamespace-qualified function of zero arity.  Any thrown exception will\nprevent reloading from occurring.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-ns-refresh-after-fn nil\n  \"Clojure function for `cider-ns-refresh' to call after reloading.\nIf nil, nothing will be invoked after reloading.  Must be a\nnamespace-qualified function of zero arity.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defun cider-ns-refresh--handle-response (response log-buffer)\n  \"Refresh LOG-BUFFER with RESPONSE.\"\n  (nrepl-dbind-response response (out err reloading status error error-ns after before)\n    (cl-flet* ((log (message &optional face)\n                    (cider-emit-into-popup-buffer log-buffer message face t))\n\n               (log-echo (message &optional face)\n                         (log message face)\n                         (unless cider-ns-refresh-show-log-buffer\n                           (let ((message-truncate-lines t))\n                             (message \"cider-ns-refresh: %s\" message)))))\n      (cond\n       (out\n        (log out))\n\n       (err\n        (log err 'font-lock-warning-face))\n\n       ((member \"invoking-before\" status)\n        (log-echo (format \"Calling %s\\n\" before) 'font-lock-string-face))\n\n       ((member \"invoked-before\" status)\n        (log-echo (format \"Successfully called %s\\n\" before) 'font-lock-string-face))\n\n       ((member \"invoked-not-resolved\" status)\n        (log-echo \"Could not resolve refresh function\\n\" 'font-lock-string-face))\n\n       (reloading\n        (log-echo (format \"Reloading %s\\n\" reloading) 'font-lock-string-face))\n\n       ((member \"reloading\" (nrepl-dict-keys response))\n        (log-echo \"Nothing to reload\\n\" 'font-lock-string-face))\n\n       ((member \"ok\" status)\n        (log-echo \"Reloading successful\\n\" 'font-lock-string-face))\n\n       (error-ns\n        (log-echo (format \"Error reloading %s\\n\" error-ns) 'font-lock-warning-face))\n\n       ((member \"invoking-after\" status)\n        (log-echo (format \"Calling %s\\n\" after) 'font-lock-string-face))\n\n       ((member \"invoked-after\" status)\n        (log-echo (format \"Successfully called %s\\n\" after) 'font-lock-string-face))))\n\n    (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer)\n                              (selected-window))\n      (with-current-buffer cider-ns-refresh-log-buffer\n        (goto-char (point-max))))\n\n    (when (member \"error\" status)\n      (cider--render-stacktrace-causes error))))\n\n(defun cider-ns-refresh--save-modified-buffers ()\n  \"Ensure any relevant modified buffers are saved before refreshing.\nIts behavior is controlled by `cider-ns-save-files-on-refresh' and\n`cider-ns-save-files-on-refresh-modes'.\"\n  (when cider-ns-save-files-on-refresh\n    (let ((dirs (seq-filter #'file-directory-p\n                            (cider-classpath-entries))))\n      (save-some-buffers\n       (not (eq cider-ns-save-files-on-refresh 'prompt))\n       (lambda ()\n         (and (seq-some #'derived-mode-p cider-ns-save-files-on-refresh-modes)\n              (seq-some (lambda (dir)\n                          (file-in-directory-p buffer-file-name dir))\n                        dirs)))))))\n\n;;;###autoload\n(defun cider-ns-reload (&optional prompt)\n  \"Send a (require 'ns :reload) to the REPL.\n\nWith an argument PROMPT, it prompts for a namespace name.  This is the\nClojure out of the box reloading experience and does not rely on\norg.clojure/tools.namespace.  See Commentary of this file for a longer list\nof differences.  From the Clojure doc: \\\":reload forces loading of all the\nidentified libs even if they are already loaded\\\".\"\n  (interactive \"P\")\n  (let ((ns (if prompt\n                (string-remove-prefix \"'\" (read-from-minibuffer \"Namespace: \" (clojure-find-ns)))\n              (clojure-find-ns))))\n    (cider-interactive-eval (format \"(require '%s :reload)\" ns))))\n\n;;;###autoload\n(defun cider-ns-reload-all (&optional prompt)\n  \"Send a (require 'ns :reload-all) to the REPL.\n\nWith an argument PROMPT, it prompts for a namespace name.  This is the\nClojure out of the box reloading experience and does not rely on\norg.clojure/tools.namespace.  See Commentary of this file for a longer list\nof differences.  From the Clojure doc: \\\":reload-all implies :reload and\nalso forces loading of all libs that the identified libs directly or\nindirectly load via require\\\".\"\n  (interactive \"P\")\n  (let ((ns (if prompt\n                (string-remove-prefix \"'\" (read-from-minibuffer \"Namespace: \" (clojure-find-ns)))\n              (clojure-find-ns))))\n    (cider-interactive-eval (format \"(require '%s :reload-all)\" ns))))\n\n;;;###autoload\n(defun cider-ns-refresh (&optional mode)\n  \"Reload modified and unloaded namespaces on the classpath.\n\nWith a single prefix argument, or if MODE is `refresh-all', reload all\nnamespaces on the classpath unconditionally.\n\nWith a double prefix argument, or if MODE is `clear', clear the state of\nthe namespace tracker before reloading.  This is useful for recovering from\nsome classes of error (for example, those caused by circular dependencies)\nthat a normal reload would not otherwise recover from.  The trade-off of\nclearing is that stale code from any deleted files may not be completely\nunloaded.\n\nWith a negative prefix argument, or if MODE is `inhibit-fns', prevent any\nrefresh functions (defined in `cider-ns-refresh-before-fn' and\n`cider-ns-refresh-after-fn') from being invoked.\"\n  (interactive \"p\")\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"refresh\")\n  (cider-ns-refresh--save-modified-buffers)\n  (let ((clear? (member mode '(clear 16)))\n        (refresh-all? (member mode '(refresh-all 4)))\n        (inhibit-refresh-fns (member mode '(inhibit-fns -1))))\n    (cider-map-repls :clj\n      (lambda (conn)\n        ;; Inside the lambda, so the buffer is not created if we error out.\n        (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer)\n                              (cider-make-popup-buffer cider-ns-refresh-log-buffer))))\n          (when cider-ns-refresh-show-log-buffer\n            (cider-popup-buffer-display log-buffer))\n          (when inhibit-refresh-fns\n            (cider-emit-into-popup-buffer log-buffer\n                                          \"inhibiting refresh functions\\n\"\n                                          nil\n                                          t))\n          (when clear?\n            (cider-nrepl-send-sync-request '(\"op\" \"refresh-clear\") conn))\n          (cider-nrepl-send-request\n           (thread-last\n             (map-merge 'list\n                        `((\"op\" ,(if refresh-all? \"refresh-all\" \"refresh\")))\n                        (cider--nrepl-print-request-map fill-column)\n                        (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn)\n                          `((\"before\" ,cider-ns-refresh-before-fn)))\n                        (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn)\n                          `((\"after\" ,cider-ns-refresh-after-fn))))\n             (seq-mapcat #'identity))\n           (lambda (response)\n             (cider-ns-refresh--handle-response response log-buffer))\n           conn))))))\n\n(provide 'cider-ns)\n;;; cider-ns.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-overlays.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53133189,"end":53133230},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53133230},"to":{"change":3,"start":53118373,"end":53118373},"introduced_by":3}],"inode":{"change":3,"pos":53118373}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53118373},"to":{"change":3,"start":53118374,"end":53133188},"introduced_by":3}],"inode":{"change":3,"pos":53118373}},"content":[{"Del":";;; cider-overlays.el --- Managing CIDER overlays  -*- lexical-binding: t; -*-\n\n;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n\n;; Author: Artur Malabarba \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;; Use `cider--make-overlay' to place a generic overlay at point.  Or use\n;; `cider--make-result-overlay' to place an interactive eval result overlay at\n;; the end of a specified line.\n\n;;; Code:\n\n(require 'cider-common)\n(require 'subr-x)\n(require 'cl-lib)\n\n\f\n;;; Customization\n(defface cider-result-overlay-face\n  '((((class color) (background light))\n     :background \"grey90\" :box (:line-width -1 :color \"yellow\"))\n    (((class color) (background dark))\n     :background \"grey10\" :box (:line-width -1 :color \"black\")))\n  \"Face used to display evaluation results at the end of line.\nIf `cider-overlays-use-font-lock' is non-nil, this face is\napplied with lower priority than the syntax highlighting.\"\n  :group 'cider\n  :package-version '(cider \"0.9.1\"))\n\n(defface cider-error-overlay-face\n  '((((class color) (background light))\n     :background \"orange red\"\n     :extend t)\n    (((class color) (background dark))\n     :background \"firebrick\"\n     :extend t))\n  \"Like `cider-result-overlay-face', but for evaluation errors.\"\n  :group 'cider\n  :package-version '(cider \"0.25.0\"))\n\n(defcustom cider-result-use-clojure-font-lock t\n  \"If non-nil, interactive eval results are font-locked as Clojure code.\"\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-overlays-use-font-lock t\n  \"If non-nil, results overlays are font-locked as Clojure code.\nIf nil, apply `cider-result-overlay-face' to the entire overlay instead of\nfont-locking it.\"\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-use-overlays 'both\n  \"Whether to display evaluation results with overlays.\nIf t, use overlays determined by `cider-result-overlay-position'.\nIf nil, display on the echo area.\nIf both, display on both places.\n\nOnly applies to evaluation commands.  To configure the debugger overlays,\nsee `cider-debug-use-overlays'.\"\n  :type '(choice (const :tag \"Display using overlays\" t)\n                 (const :tag \"Display in echo area\" nil)\n                 (const :tag \"Both\" both))\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-result-overlay-position 'at-eol\n  \"Where to display result overlays for inline evaluation and the debugger.\nIf 'at-eol, display at the end of the line.\nIf 'at-point, display at the end of the respective sexp.\"\n  :group 'cider\n  :type ''(choice (const :tag \"End of line\" at-eol)\n                  (const :tag \"End of sexp\" at-point))\n  :package-version '(cider . \"0.23.0\"))\n\n(defcustom cider-eval-result-prefix \"=> \"\n  \"The prefix displayed in the minibuffer before a result value.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.5.0\"))\n\n(defcustom cider-eval-result-duration 'command\n  \"Duration, in seconds, of CIDER's eval-result overlays.\nIf nil, overlays last indefinitely.\nIf the symbol `command', they're erased after the next command.\nIf the symbol `change', they last until the next change to the buffer.\nAlso see `cider-use-overlays'.\"\n  :type '(choice (integer :tag \"Duration in seconds\")\n                 (const :tag \"Until next command\" command)\n                 (const :tag \"Until next buffer change\" change)\n                 (const :tag \"Last indefinitely\" nil))\n  :group 'cider\n  :package-version '(cider . \"0.10.0\"))\n\n\f\n;;; Overlay logic\n(defun cider--delete-overlay (ov &rest _)\n  \"Safely delete overlay OV.\nNever throws errors, and can be used in an overlay's modification-hooks.\"\n  (ignore-errors (delete-overlay ov)))\n\n(defun cider--make-overlay (l r type &rest props)\n  \"Place an overlay between L and R and return it.\nTYPE is a symbol put on the overlay's category property.  It is used to\neasily remove all overlays from a region with:\n    (remove-overlays start end 'category TYPE)\nPROPS is a plist of properties and values to add to the overlay.\"\n  (let ((o (make-overlay l (or r l) (current-buffer))))\n    (overlay-put o 'category type)\n    (overlay-put o 'cider-temporary t)\n    (while props (overlay-put o (pop props) (pop props)))\n    (push #'cider--delete-overlay (overlay-get o 'modification-hooks))\n    o))\n\n(defun cider--remove-result-overlay (&rest _)\n  \"Remove result overlay from current buffer.\nThis function also removes itself from `post-command-hook' and\n`after-change-functions'.\"\n  (let ((hook (pcase cider-eval-result-duration\n                (`command 'post-command-hook)\n                (`change 'after-change-functions))))\n    (remove-hook hook #'cider--remove-result-overlay 'local))\n  (remove-overlays nil nil 'category 'result))\n\n(defun cider--remove-result-overlay-after-command ()\n  \"Add `cider--remove-result-overlay' locally to `post-command-hook'.\nThis function also removes itself from `post-command-hook'.\"\n  (remove-hook 'post-command-hook #'cider--remove-result-overlay-after-command 'local)\n  (add-hook 'post-command-hook #'cider--remove-result-overlay nil 'local))\n\n(defface cider-fringe-good-face\n  '((((class color) (background light)) :foreground \"lightgreen\")\n    (((class color) (background dark)) :foreground \"darkgreen\"))\n  \"Face used on the fringe indicator for successful evaluation.\"\n  :group 'cider)\n\n(defconst cider--fringe-overlay-good\n  (propertize \" \" 'display '(left-fringe empty-line cider-fringe-good-face))\n  \"The before-string property that adds a green indicator on the fringe.\")\n\n(defcustom cider-use-fringe-indicators t\n  \"Whether to display evaluation indicators on the left fringe.\"\n  :safe #'booleanp\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider . \"0.13.0\"))\n\n(defun cider--make-fringe-overlay (&optional end)\n  \"Place an eval indicator at the fringe before a sexp.\nEND is the position where the sexp ends, and defaults to point.\"\n  (when cider-use-fringe-indicators\n    (with-current-buffer (if (markerp end)\n                             (marker-buffer end)\n                           (current-buffer))\n      (save-excursion\n        (if end\n            (goto-char end)\n          (setq end (point)))\n        (clojure-forward-logical-sexp -1)\n        ;; Create the green-circle overlay.\n        (cider--make-overlay (point) end 'cider-fringe-indicator\n                             'before-string cider--fringe-overlay-good)))))\n\n(cl-defun cider--make-result-overlay (value &rest props &key where duration (type 'result)\n                                            (format (concat \" \" cider-eval-result-prefix \"%s \"))\n                                            (prepend-face 'cider-result-overlay-face)\n                                            &allow-other-keys)\n  \"Place an overlay displaying VALUE at the position determined by WHERE.\nVALUE is used as the overlay's after-string property, meaning it is\ndisplayed at the end of the overlay.\nReturn nil if the overlay was not placed or if it might not be visible, and\nreturn the overlay otherwise.\n\nReturn the overlay if it was placed successfully, and nil if it failed.\n\nThis function takes some optional keyword arguments:\n\n  If WHERE is a number or a marker, apply the overlay as determined by\n  `cider-result-overlay-position'.  If it is a cons cell, the car and cdr\n  determine the start and end of the overlay.\n  DURATION takes the same possible values as the\n  `cider-eval-result-duration' variable.\n  TYPE is passed to `cider--make-overlay' (defaults to `result').\n  FORMAT is a string passed to `format'.  It should have\n  exactly one %s construct (for VALUE).\n\nAll arguments beyond these (PROPS) are properties to be used on the\noverlay.\"\n  (declare (indent 1))\n  (while (keywordp (car props))\n    (setq props (cdr (cdr props))))\n  ;; If the marker points to a dead buffer, don't do anything.\n  (let ((buffer (cond\n                 ((markerp where) (marker-buffer where))\n                 ((markerp (car-safe where)) (marker-buffer (car where)))\n                 (t (current-buffer)))))\n    (with-current-buffer buffer\n      (save-excursion\n        (when (number-or-marker-p where)\n          (goto-char where))\n        ;; Make sure the overlay is actually at the end of the sexp.\n        (skip-chars-backward \"\\r\\n[:blank:]\")\n        (let* ((beg (if (consp where)\n                        (car where)\n                      (save-excursion\n                        (clojure-backward-logical-sexp 1)\n                        (point))))\n               (end (if (consp where)\n                        (cdr where)\n                      (pcase cider-result-overlay-position\n                        ('at-eol (line-end-position))\n                        ('at-point (point)))))\n               ;; Specify `default' face, otherwise unformatted text will\n               ;; inherit the face of the following text.\n               (display-string (format (propertize format 'face 'default) value))\n               (o nil))\n          (remove-overlays beg end 'category type)\n          (funcall (if cider-overlays-use-font-lock\n                       #'font-lock-prepend-text-property\n                     #'put-text-property)\n                   0 (length display-string)\n                   'face prepend-face\n                   display-string)\n          ;; If the display spans multiple lines or is very long, display it at\n          ;; the beginning of the next line.\n          (when (or (string-match \"\\n.\" display-string)\n                    (> (string-width display-string)\n                       (- (window-width) (current-column))))\n            (setq display-string (concat \" \\n\" display-string)))\n          ;; Put the cursor property only once we're done manipulating the\n          ;; string, since we want it to be at the first char.\n          (put-text-property 0 1 'cursor 0 display-string)\n          (when (> (string-width display-string) (* 3 (window-width)))\n            (setq display-string\n                  (concat (substring display-string 0 (* 3 (window-width)))\n                          (substitute-command-keys\n                           \"...\\nResult truncated. Type `\\\\[cider-inspect-last-result]' to inspect it.\"))))\n          ;; Create the result overlay.\n          (setq o (apply #'cider--make-overlay\n                         beg end type\n                         'after-string display-string\n                         props))\n          (pcase duration\n            ((pred numberp) (run-at-time duration nil #'cider--delete-overlay o))\n            (`command\n             ;; If inside a command-loop, tell `cider--remove-result-overlay'\n             ;; to only remove after the *next* command.\n             (if this-command\n                 (add-hook 'post-command-hook\n                           #'cider--remove-result-overlay-after-command\n                           nil 'local)\n               (cider--remove-result-overlay-after-command)))\n            (`change\n             (add-hook 'after-change-functions\n                       #'cider--remove-result-overlay\n                       nil 'local)))\n          (when-let* ((win (get-buffer-window buffer)))\n            ;; Left edge is visible.\n            (when (and (<= (window-start win) (point) (window-end win))\n                       ;; Right edge is visible. This is a little conservative\n                       ;; if the overlay contains line breaks.\n                       (or (< (+ (current-column) (string-width value))\n                              (window-width win))\n                           (not truncate-lines)))\n              o)))))))\n\n\f\n;;; Displaying eval result\n(defun cider--display-interactive-eval-result (value &optional point overlay-face)\n  \"Display the result VALUE of an interactive eval operation.\nVALUE is syntax-highlighted and displayed in the echo area.\nOVERLAY-FACE is the face applied to the overlay, which defaults to\n`cider-result-overlay-face' if nil.\nIf POINT and `cider-use-overlays' are non-nil, it is also displayed in an\noverlay at the end of the line containing POINT.\nNote that, while POINT can be a number, it's preferable to be a marker, as\nthat will better handle some corner cases where the original buffer is not\nfocused.\"\n  (let* ((font-value (if cider-result-use-clojure-font-lock\n                         (cider-font-lock-as-clojure value)\n                       value))\n         (used-overlay (when (and point cider-use-overlays)\n                         (cider--make-result-overlay font-value\n                           :where point\n                           :duration cider-eval-result-duration\n                           :prepend-face (or overlay-face 'cider-result-overlay-face)))))\n    (message\n     \"%s\"\n     (propertize (format \"%s%s\" cider-eval-result-prefix font-value)\n                 ;; The following hides the message from the echo-area, but\n                 ;; displays it in the Messages buffer. We only hide the message\n                 ;; if the user wants to AND if the overlay succeeded.\n                 'invisible (and used-overlay\n                                 (not (eq cider-use-overlays 'both)))))))\n\n\f\n;;; Fragile buttons\n(defface cider-fragile-button-face\n  '((((type graphic))\n     :box (:line-width 3 :style released-button)\n     :inherit font-lock-warning-face)\n    (t :inverse-video t))\n  \"Face for buttons that vanish when clicked.\"\n  :package-version '(cider . \"0.12.0\")\n  :group 'cider)\n\n(define-button-type 'cider-fragile\n  'action #'cider--overlay-destroy\n  'follow-link t\n  'face nil\n  'modification-hooks '(cider--overlay-destroy)\n  'help-echo \"RET: delete this.\")\n\n(defun cider--overlay-destroy (ov &rest r)\n  \"Delete overlay OV and its underlying text.\nIf any other arguments are given (collected in R), only actually do anything\nif the first one is non-nil.  This is so it works in `modification-hooks'.\"\n  (unless (and r (not (car r)))\n    (let ((inhibit-modification-hooks t)\n          (beg (copy-marker (overlay-start ov)))\n          (end (copy-marker (overlay-end ov))))\n      (delete-overlay ov)\n      (delete-region beg end)\n      (goto-char beg)\n      (when (= (char-after) (char-before) ?\\n)\n        (delete-char 1)))))\n\n(provide 'cider-overlays)\n;;; cider-overlays.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-pkg.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53118335,"end":53118371},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53118371},"to":{"change":3,"start":53117538,"end":53117538},"introduced_by":3}],"inode":{"change":3,"pos":53117538}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53117538},"to":{"change":3,"start":53117539,"end":53118334},"introduced_by":3}],"inode":{"change":3,"pos":53117538}},"content":[{"Del":"(define-package \"cider\" \"20221026.1100\" \"Clojure Interactive Development Environment that Rocks\"\n  '((emacs \"26\")\n    (clojure-mode \"5.15.1\")\n    (parseedn \"1.0.6\")\n    (queue \"0.2\")\n    (spinner \"1.7\")\n    (seq \"2.22\")\n    (sesman \"0.3.2\"))\n  :commit \"d08609feb7141b8dbece6abb958bddd4ef0129d5\" :authors\n  '((\"Tim King\" . \"kingtim@gmail.com\")\n    (\"Phil Hagelberg\" . \"technomancy@gmail.com\")\n    (\"Bozhidar Batsov\" . \"bozhidar@batsov.dev\")\n    (\"Artur Malabarba\" . \"bruce.connor.am@gmail.com\")\n    (\"Hugo Duncan\" . \"hugo@hugoduncan.org\")\n    (\"Steve Purcell\" . \"steve@sanityinc.com\"))\n  :maintainer\n  '(\"Bozhidar Batsov\" . \"bozhidar@batsov.dev\")\n  :keywords\n  '(\"languages\" \"clojure\" \"cider\")\n  :url \"http://www.github.com/clojure-emacs/cider\")\n;; Local Variables:\n;; no-byte-compile: t\n;; End:\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-popup.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53117498,"end":53117536},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53117536},"to":{"change":3,"start":53111949,"end":53111949},"introduced_by":3}],"inode":{"change":3,"pos":53111949}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53111949},"to":{"change":3,"start":53111950,"end":53117497},"introduced_by":3}],"inode":{"change":3,"pos":53111949}},"content":[{"Del":";;; cider-popup.el --- Creating and quitting popup buffers  -*- lexical-binding: t; -*-\n\n;; Copyright © 2015-2022  Bozhidar Batsov, Artur Malabarba and CIDER contributors\n\n;; Author: Artur Malabarba \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;; Common functionality for dealing with popup buffers.\n\n;;; Code:\n\n(require 'subr-x)\n\n(define-minor-mode cider-popup-buffer-mode\n  \"Mode for CIDER popup buffers.\"\n  :lighter (\" cider-tmp\")\n  :keymap '((\"q\" .  cider-popup-buffer-quit-function)))\n\n(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit\n  \"The function that is used to quit a temporary popup buffer.\")\n\n(defun cider-popup-buffer-quit-function (&optional kill-buffer-p)\n  \"Wrapper to invoke the function `cider-popup-buffer-quit-function'.\nKILL-BUFFER-P is passed along.\"\n  (interactive)\n  (funcall cider-popup-buffer-quit-function kill-buffer-p))\n\n(defun cider-popup-buffer (name &optional select mode ancillary)\n  \"Create new popup buffer called NAME.\nIf SELECT is non-nil, select the newly created window.\nIf major MODE is non-nil, enable it for the popup buffer.\nIf ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'\nand automatically removed when killed.\"\n  (thread-first (cider-make-popup-buffer name mode ancillary)\n                (cider-popup-buffer-display select)))\n\n(defun cider-popup-buffer-display (buffer &optional select)\n  \"Display BUFFER.\nIf SELECT is non-nil, select the BUFFER.\"\n  (let ((window (get-buffer-window buffer 'visible)))\n    (when window\n      (with-current-buffer buffer\n        (set-window-point window (point))))\n    ;; If the buffer we are popping up is already displayed in the selected\n    ;; window, the below `inhibit-same-window' logic will cause it to be\n    ;; displayed twice - so we early out in this case. Note that we must check\n    ;; `selected-window', as async request handlers are executed in the context\n    ;; of the current connection buffer (i.e. `current-buffer' is dynamically\n    ;; bound to that).\n    (unless (eq window (selected-window))\n      ;; Non nil `inhibit-same-window' ensures that current window is not covered\n      ;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected\n      ;; if that's where the buffer is being shown.\n      (funcall (if select #'pop-to-buffer #'display-buffer)\n               buffer `(nil . ((inhibit-same-window . ,pop-up-windows)\n                               (reusable-frames . visible))))))\n  buffer)\n\n(defun cider-popup-buffer-quit (&optional kill)\n  \"Quit the current (temp) window.\nBury its buffer using `quit-restore-window'.\nIf prefix argument KILL is non-nil, kill the buffer instead of burying it.\"\n  (interactive)\n  (quit-restore-window (selected-window) (if kill 'kill 'append)))\n\n(defvar-local cider-popup-output-marker nil)\n\n(defvar cider-ancillary-buffers nil\n  \"A list ancillary buffers created by the various CIDER commands.\nWe track them mostly to be able to clean them up on quit.\")\n\n(defun cider-make-popup-buffer (name &optional mode ancillary)\n  \"Create a temporary buffer called NAME using major MODE (if specified).\nIf ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'\nand automatically removed when killed.\"\n  (with-current-buffer (get-buffer-create name)\n    (kill-all-local-variables)\n    (setq buffer-read-only nil)\n    (erase-buffer)\n    (when mode\n      (funcall mode))\n    (cider-popup-buffer-mode 1)\n    (setq cider-popup-output-marker (point-marker))\n    (setq buffer-read-only t)\n    (when ancillary\n      (add-to-list 'cider-ancillary-buffers name)\n      (add-hook 'kill-buffer-hook\n                (lambda ()\n                  (setq cider-ancillary-buffers\n                        (remove name cider-ancillary-buffers)))\n                nil 'local))\n    (current-buffer)))\n\n(defun cider-emit-into-popup-buffer (buffer value &optional face inhibit-indent)\n  \"Emit into BUFFER the provided VALUE optionally using FACE.\nIndent emitted value (usually a sexp) unless INHIBIT-INDENT is specified\nand non-nil.\"\n  ;; Long string output renders Emacs unresponsive and users might intentionally\n  ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and\n  ;; silently ignore the output.\n  (when (buffer-live-p buffer)\n    (with-current-buffer buffer\n      (let ((inhibit-read-only t)\n            (buffer-undo-list t)\n            (moving (= (point) cider-popup-output-marker)))\n        (save-excursion\n          (goto-char cider-popup-output-marker)\n          (let ((value-str (format \"%s\" value)))\n            (when face\n              (add-face-text-property 0 (length value-str) face nil value-str))\n            (insert value-str))\n          (unless inhibit-indent\n            (indent-sexp))\n          (set-marker cider-popup-output-marker (point)))\n        (when moving (goto-char cider-popup-output-marker))))))\n\n(provide 'cider-popup)\n\n;;; cider-popup.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-profile.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53111907,"end":53111947},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53111947},"to":{"change":3,"start":53103848,"end":53103848},"introduced_by":3}],"inode":{"change":3,"pos":53103848}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53103848},"to":{"change":3,"start":53103849,"end":53111906},"introduced_by":3}],"inode":{"change":3,"pos":53103848}},"content":[{"Del":";;; cider-profile.el --- CIDER support for profiling  -*- lexical-binding: t; -*-\n\n;; Copyright © 2014-2022 Edwin Watkeys and CIDER contributors\n\n;; Author: Edwin Watkeys \n;;         Juan E. Maya \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;; Provides coarse-grained interactive profiling support.\n;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile).\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'cider-eval)\n\n(defconst cider-profile-buffer \"*cider-profile*\")\n\n(defvar cider-profile-map\n  (let ((map (define-prefix-command 'cider-profile-map)))\n    (define-key map (kbd \"t\") #'cider-profile-toggle)\n    (define-key map (kbd \"C-t\") #'cider-profile-toggle)\n    (define-key map (kbd \"c\") #'cider-profile-clear)\n    (define-key map (kbd \"C-c\") #'cider-profile-clear)\n    (define-key map (kbd \"S\") #'cider-profile-summary)\n    (define-key map (kbd \"C-S\") #'cider-profile-summary)\n    (define-key map (kbd \"s\") #'cider-profile-var-summary)\n    (define-key map (kbd \"C-s\") #'cider-profile-var-summary)\n    (define-key map (kbd \"n\") #'cider-profile-ns-toggle)\n    (define-key map (kbd \"C-n\") #'cider-profile-ns-toggle)\n    (define-key map (kbd \"v\") #'cider-profile-var-profiled-p)\n    (define-key map (kbd \"C-v\") #'cider-profile-var-profiled-p)\n    (define-key map (kbd \"+\") #'cider-profile-samples)\n    (define-key map (kbd \"C-+\") #'cider-profile-samples)\n    map)\n  \"CIDER profiler keymap.\")\n\n(defconst cider-profile-menu\n  '(\"Profile\"\n    [\"Toggle var profiling\" cider-profile-toggle]\n    [\"Toggle namespace profiling\" cider-profile-ns-toggle]\n    \"--\"\n    [\"Display var profiling status\" cider-profile-var-profiled-p]\n    [\"Display max sample count\" cider-profile-samples]\n    [\"Display var summary\" cider-profile-var-summary]\n    [\"Display summary\" cider-profile-summary]\n    [\"Clear data\" cider-profile-clear])\n  \"CIDER profiling submenu.\")\n\n(defun cider-profile--make-response-handler (handler &optional buffer)\n  \"Make a response handler using value handler HANDLER for connection BUFFER.\n\nOptional argument BUFFER defaults to current buffer.\"\n  (nrepl-make-response-handler\n   (or buffer (current-buffer)) handler nil nil nil))\n\n;;;###autoload\n(defun cider-profile-samples (&optional query)\n  \"Displays current max-sample-count.\nIf optional QUERY is specified, set max-sample-count and display new value.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"set-max-samples\")\n  (cider-ensure-op-supported \"get-max-samples\")\n  (if (not (null query))\n      (cider-nrepl-send-request\n       (let ((max-samples (if (numberp query) query '())))\n         (message \"query: %s\" max-samples)\n         `(\"op\" \"set-max-samples\" \"max-samples\" ,max-samples))\n       (cider-profile--make-response-handler\n        (lambda (_buffer value)\n          (let ((value (if (zerop (length value)) \"unlimited\" value)))\n            (message \"max-sample-count is now %s\" value)))))\n    (cider-nrepl-send-request\n     '(\"op\" \"get-max-samples\")\n     (cider-profile--make-response-handler\n      (lambda (_buffer value)\n        (let ((value (if (zerop (length value)) \"unlimited\" value)))\n          (message \"max-sample-count is now %s\" value))))))\n  query)\n\n;;;###autoload\n(defun cider-profile-var-profiled-p (query)\n  \"Displays the profiling status of var under point.\nPrompts for var if none under point or QUERY is present.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"is-var-profiled\")\n  (cider-read-symbol-name\n   \"Report profiling status for var: \"\n   (lambda (sym)\n     (let ((ns (cider-current-ns)))\n       (cider-nrepl-send-request\n        `(\"op\" \"is-var-profiled\"\n          \"ns\" ,ns\n          \"sym\" ,sym)\n        (cider-profile--make-response-handler\n         (lambda (_buffer value)\n           (pcase value\n             (\"profiled\" (message \"Profiling is currently enabled for %s/%s\" ns sym))\n             (\"unprofiled\" (message \"Profiling  is currently disabled for %s/%s\" ns sym))\n             (\"unbound\" (message \"%s/%s is unbound\" ns sym)))))))))\n  query)\n\n;;;###autoload\n(defun cider-profile-ns-toggle (&optional query)\n  \"Toggle profiling for the ns associated with optional QUERY.\n\nIf optional argument QUERY is non-nil, prompt for ns.  Otherwise use\ncurrent ns.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"toggle-profile-ns\")\n  (let ((ns (if query\n                (completing-read \"Toggle profiling for ns: \"\n                                 (cider-sync-request:ns-list))\n              (cider-current-ns))))\n    (cider-nrepl-send-request\n     `(\"op\" \"toggle-profile-ns\"\n       \"ns\" ,ns)\n     (cider-profile--make-response-handler\n      (lambda (_buffer value)\n        (pcase value\n          (\"profiled\" (message \"Profiling enabled for %s\" ns))\n          (\"unprofiled\" (message \"Profiling disabled for %s\" ns)))))))\n  query)\n\n;;;###autoload\n(defun cider-profile-toggle (query)\n  \"Toggle profiling for the given QUERY.\nDefaults to the symbol at point.\nWith prefix arg or no symbol at point, prompts for a var.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"toggle-profile\")\n  (cider-read-symbol-name\n   \"Toggle profiling for var: \"\n   (lambda (sym)\n     (let ((ns (cider-current-ns)))\n       (cider-nrepl-send-request\n        `(\"op\" \"toggle-profile\"\n          \"ns\" ,ns\n          \"sym\" ,sym)\n        (cider-profile--make-response-handler\n         (lambda (_buffer value)\n           (pcase value\n             (\"profiled\" (message \"Profiling enabled for %s/%s\" ns sym))\n             (\"unprofiled\" (message \"Profiling disabled for %s/%s\" ns sym))\n             (\"unbound\" (message \"%s/%s is unbound\" ns sym)))))))))\n  query)\n\n(defun cider-profile-display-stats (stats-response)\n  \"Displays the STATS-RESPONSE on `cider-profile-buffer`.\"\n  (let ((table (nrepl-dict-get stats-response \"err\")))\n    (if cider-profile-buffer\n        (let ((buffer (cider-make-popup-buffer cider-profile-buffer)))\n          (with-current-buffer buffer\n            (let ((inhibit-read-only t)) (insert table)))\n          (display-buffer buffer)\n          (let ((window (get-buffer-window buffer)))\n            (set-window-point window 0)\n            (select-window window)\n            (fit-window-to-buffer window)))\n      (cider-emit-interactive-eval-err-output table))))\n\n;;;###autoload\n(defun cider-profile-summary ()\n  \"Display a summary of currently collected profile data.\"\n  (interactive)\n  (cider-ensure-op-supported \"profile-summary\")\n  (cider-profile-display-stats\n   (cider-nrepl-send-sync-request '(\"op\" \"profile-summary\"))))\n\n;;;###autoload\n(defun cider-profile-var-summary (query)\n  \"Display profile data for var under point QUERY.\nDefaults to the symbol at point.  With prefix arg or no symbol at point,\nprompts for a var.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"profile-var-summary\")\n  (cider-read-symbol-name\n   \"Profile-summary for var: \"\n   (lambda (sym)\n     (cider-profile-display-stats\n      (cider-nrepl-send-sync-request\n       `(\"op\" \"profile-var-summary\"\n         \"ns\" ,(cider-current-ns)\n         \"sym\" ,sym)))))\n  query)\n\n;;;###autoload\n(defun cider-profile-clear ()\n  \"Clear any collected profile data.\"\n  (interactive)\n  (cider-ensure-op-supported \"clear-profile\")\n  (cider-nrepl-send-request\n   '(\"op\" \"clear-profile\")\n   (cider-profile--make-response-handler\n    (lambda (_buffer value)\n      (when (equal value \"cleared\")\n        (message \"Cleared profile data\"))))))\n\n(provide 'cider-profile)\n\n;;; cider-profile.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-repl-history.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53103801,"end":53103846},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53103846},"to":{"change":3,"start":53073242,"end":53073242},"introduced_by":3}],"inode":{"change":3,"pos":53073242}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":53073242},"to":{"change":3,"start":53073243,"end":53103800},"introduced_by":3}],"inode":{"change":3,"pos":53073242}},"content":[{"Del":";;; cider-repl-history.el --- REPL input history browser  -*- lexical-binding: t; -*-\n\n;; Copyright (c) 2017-2022 John Valente and browse-kill-ring authors\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;; This file is not part of GNU Emacs.\n\n;; Based heavily on browse-kill-ring\n;; https://github.com/browse-kill-ring/browse-kill-ring\n\n;;; Commentary:\n\n;; REPL input history browser for CIDER.\n\n;; Allows you to browse the full input history for your REPL buffer, and\n;; insert previous commands at the prompt.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'cider-popup)\n(require 'clojure-mode)\n(require 'derived)\n(require 'pulse)\n(require 'sesman)\n\n(defconst cider-repl-history-buffer \"*cider-repl-history*\")\n\n(defgroup cider-repl-history nil\n  \"A package for browsing and inserting the items in the CIDER command history.\"\n  :prefix \"cider-repl-history-\"\n  :group 'cider)\n\n(defvar cider-repl-history-display-styles\n  '((separated . cider-repl-history-insert-as-separated)\n    (one-line . cider-repl-history-insert-as-one-line)))\n\n(defcustom cider-repl-history-display-style 'separated\n  \"How to display the CIDER command history items.\n\nIf `one-line', then replace newlines with \\\"\\\\n\\\" for display.\n\nIf `separated', then display `cider-repl-history-separator' between\nentries.\"\n  :type '(choice (const :tag \"One line\" one-line)\n                 (const :tag \"Separated\" separated))\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-quit-action 'quit-window\n  \"What action to take when `cider-repl-history-quit' is called.\n\nIf `bury-buffer', then simply bury the *cider-repl-history* buffer, but keep\nthe window.\n\nIf `bury-and-delete-window', then bury the buffer, and (if there is\nmore than one window) delete the window.\n\nIf `delete-and-restore', then restore the window configuration to what it was\nbefore `cider-repl-history' was called, and kill the *cider-repl-history*\nbuffer.\n\nIf `quit-window', then restore the window configuration to what\nit was before `cider-repl-history' was called, and bury *cider-repl-history*.\nThis is the default.\n\nIf `kill-and-delete-window', then kill the *cider-repl-history* buffer, and\ndelete the window on close.\n\nOtherwise, it should be a function to call.\"\n  ;; Note, if you use one of the non-\"delete\" options, after you \"quit\",\n  ;; the *cider-repl-history* buffer is still available.  If you are using\n  ;; `cider-repl-history-show-preview', and you switch to *cider-repl-history* (i.e.,\n  ;; with C-x b), it will not give the preview unless and until you \"update\"\n  ;; the *cider-repl-history* buffer.\n  ;;\n  ;; This really should not be an issue, because there's no reason to \"switch\"\n  ;; back to the buffer.  If you want to get it back, you can just do C-c M-p\n  ;; from the REPL buffer.\n\n  ;; If you get in this situation and find it annoying, you can either disable\n  ;; the preview, or set `cider-repl-history-quit-action' to 'delete-and-restore.\n  ;; Then you will simply not have the *cider-repl-history* buffer after you quit,\n  ;; and it won't be an issue.\n\n  :type '(choice (const :tag \"Bury buffer\"\n                        :value bury-buffer)\n                 (const :tag \"Bury buffer and delete window\"\n                        :value bury-and-delete-window)\n                 (const :tag \"Delete window\"\n                        :value delete-and-restore)\n                 (const :tag \"Save and restore\"\n                        :value quit-window)\n                 (const :tag \"Kill buffer and delete window\"\n                        :value kill-and-delete-window)\n                 function)\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-resize-window nil\n  \"Whether to resize the `cider-repl-history' window to fit its contents.\nValue is either t, meaning yes, or a cons pair of integers,\n (MAXIMUM . MINIMUM) for the size of the window.  MAXIMUM defaults to\nthe window size chosen by `pop-to-buffer'; MINIMUM defaults to\n`window-min-height'.\"\n  :type '(choice (const :tag \"No\" nil)\n                 (const :tag \"Yes\" t)\n                 (cons (integer :tag \"Maximum\") (integer :tag \"Minimum\")))\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-separator \";;;;;;;;;;\"\n  \"The string separating entries in the `separated' style.\nSee `cider-repl-history-display-style'.\"\n  ;; The (default) separator is a Clojure comment, to preserve fontification\n  ;; in the buffer.\n  :type 'string\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-recenter nil\n  \"If non-nil, then always keep the current entry at the top of the window.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-highlight-current-entry nil\n  \"If non-nil, highlight the currently selected command history entry.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-highlight-inserted-item nil\n  \"If non-nil, then temporarily highlight the inserted command history entry.\nThe value selected controls how the inserted item is highlighted,\npossible values are `solid' (highlight the inserted text for a\nfixed period of time), or `pulse' (fade out the highlighting gradually).\nSetting this variable to the value t will select the default\nhighlighting style, which currently `pulse'.\n\nThe variable `cider-repl-history-inserted-item-face' contains the\nface used for highlighting.\"\n  :type '(choice (const nil) (const t) (const solid) (const pulse))\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-separator-face 'bold\n  \"The face in which to highlight the `cider-repl-history-separator'.\"\n  :type 'face\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-current-entry-face 'highlight\n  \"The face in which to highlight the command history current entry.\"\n  :type 'face\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-inserted-item-face 'highlight\n  \"The face in which to highlight the inserted item.\"\n  :type 'face\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-maximum-display-length nil\n  \"Whether or not to limit the length of displayed items.\n\nIf this variable is an integer, the display of the command history will be\nlimited to that many characters.\nSetting this variable to nil means no limit.\"\n  :type '(choice (const :tag \"None\" nil)\n                 integer)\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-display-duplicates t\n  \"If non-nil, then display duplicate items in the command history.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-display-duplicate-highest t\n  \"If non-nil, then display most recent duplicate items in the command history.\nOnly takes effect when `cider-repl-history-display-duplicates' is nil.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-text-properties nil\n  \"If non-nil, maintain text properties of the command history items.\"\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-hook nil\n  \"A list of functions to call after `cider-repl-history'.\"\n  :type 'hook\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-repl-history-show-preview nil\n  \"If non-nil, show a preview of the inserted text in the REPL buffer.\n\nThe REPL buffer would show a preview of what the buffer would look like\nif the item under point were inserted.\"\n\n  :type 'boolean\n  :package-version '(cider . \"0.15.0\"))\n\n(defvar cider-repl-history-repl-window nil\n  \"The window in which chosen command history data will be inserted.\nIt is probably not a good idea to set this variable directly; simply\ncall `cider-repl-history' again.\")\n\n(defvar cider-repl-history-repl-buffer nil\n  \"The buffer in which chosen command history data will be inserted.\nIt is probably not a good idea to set this variable directly; simply\ncall `cider-repl-history' again.\")\n\n(defvar cider-repl-history-preview-overlay nil\n  \"Overlay used to preview what would happen if the user inserted the given text.\")\n\n(defvar cider-repl-history-previous-overlay nil\n  \"Previous overlay within *cider-repl-history* buffer.\")\n\n\n(defun cider-repl-history-get-history ()\n  \"Function to retrieve history from the REPL buffer.\"\n  (if cider-repl-history-repl-buffer\n      (buffer-local-value\n       'cider-repl-input-history\n       cider-repl-history-repl-buffer)\n    (error \"Variable `cider-repl-history-repl-buffer' not bound to a buffer\")))\n\n(defun cider-repl-history-resize-window ()\n  \"Resize the *cider-repl-history* window if needed.\nControlled by variable `cider-repl-history-resize-window'.\"\n  (when cider-repl-history-resize-window\n    (apply #'fit-window-to-buffer (selected-window)\n           (if (consp cider-repl-history-resize-window)\n               (list (car cider-repl-history-resize-window)\n                     (or (cdr cider-repl-history-resize-window)\n                         window-min-height))\n             (list nil window-min-height)))))\n\n(defun cider-repl-history-read-regexp (msg use-default-p)\n  \"Get a regular expression from the user.\nPrompts with MSG; previous entry is default if USE-DEFAULT-P.\"\n  (let* ((default (car regexp-history))\n         (prompt (if (and default use-default-p)\n                     (format \"%s for regexp (default `%s'): \"\n                             msg\n                             default)\n                   (format \"%s (regexp): \" msg)))\n         (input\n          (read-from-minibuffer prompt nil nil nil 'regexp-history\n                                (if use-default-p nil default))))\n    (if (equal input \"\")\n        (if use-default-p default nil)\n      input)))\n\n(defun cider-repl-history-clear-preview ()\n  \"Clear the preview, if one is present.\"\n  (interactive)\n  (when cider-repl-history-preview-overlay\n    (cl-assert (overlayp cider-repl-history-preview-overlay))\n    (delete-overlay cider-repl-history-preview-overlay)))\n\n(defun cider-repl-history-cleanup-on-exit ()\n  \"Function called when the user is finished with `cider-repl-history'.\nThis function performs any cleanup that is required when the user\nhas finished interacting with the *cider-repl-history* buffer.  For now\nthe only cleanup performed is to remove the preview overlay, if\nit's turned on.\"\n  (cider-repl-history-clear-preview))\n\n(defun cider-repl-history-quit ()\n  \"Take the action specified by `cider-repl-history-quit-action'.\"\n  (interactive)\n  (cider-repl-history-cleanup-on-exit)\n  (pcase cider-repl-history-quit-action\n    (`delete-and-restore\n     (quit-restore-window (selected-window) 'kill))\n    (`quit-window\n     (quit-window))\n    (`kill-and-delete-window\n     (kill-buffer (current-buffer))\n     (unless (= (count-windows) 1)\n       (delete-window)))\n    (`bury-and-delete-window\n     (bury-buffer)\n     (unless (= (count-windows) 1)\n       (delete-window)))\n    (_\n     (funcall cider-repl-history-quit-action))))\n\n(defun cider-repl-history-preview-overlay-setup (orig-buf)\n  \"Setup the preview overlay in ORIG-BUF.\"\n  (when cider-repl-history-show-preview\n    (with-current-buffer orig-buf\n      (let* ((will-replace (region-active-p))\n             (start (if will-replace\n                        (min (point) (mark))\n                      (point)))\n             (end (if will-replace\n                      (max (point) (mark))\n                    (point))))\n        (cider-repl-history-clear-preview)\n        (setq cider-repl-history-preview-overlay\n              (make-overlay start end orig-buf))\n        (overlay-put cider-repl-history-preview-overlay\n                     'invisible t)))))\n\n(defun cider-repl-history-highlight-inserted (start end)\n  \"Insert the text between START and END.\"\n  (pcase cider-repl-history-highlight-inserted-item\n    ((or `pulse `t)\n     (let ((pulse-delay .05) (pulse-iterations 10))\n       (with-no-warnings\n         (pulse-momentary-highlight-region\n          start end cider-repl-history-inserted-item-face))))\n    (`solid\n     (let ((o (make-overlay start end)))\n       (overlay-put o 'face cider-repl-history-inserted-item-face)\n       (sit-for 0.5)\n       (delete-overlay o)))))\n\n(defun cider-repl-history-insert-and-highlight (str)\n  \"Helper function to insert STR at point, highlighting it if appropriate.\"\n  (let ((before-insert (point)))\n    (let (deactivate-mark)\n      (insert-for-yank str))\n    (cider-repl-history-highlight-inserted\n     before-insert\n     (point))))\n\n(defun cider-repl-history-target-overlay-at (_position &optional no-error)\n  \"Return overlay at POSITION that has property `cider-repl-history-target'.\nIf no such overlay, raise an error unless NO-ERROR is true, in which\ncase return nil.\"\n  (let ((ovs  (overlays-at (point))))\n    (catch 'cider-repl-history-target-overlay-at\n      (dolist (ov ovs)\n        (when (overlay-get ov 'cider-repl-history-target)\n          (throw 'cider-repl-history-target-overlay-at ov)))\n      (unless no-error\n        (error \"No CIDER history item here\")))))\n\n(defun cider-repl-history-current-string (pt &optional no-error)\n  \"Find the string to insert into the REPL by looking for the overlay at PT.\nMight error unless NO-ERROR set.\"\n  (let ((o (cider-repl-history-target-overlay-at pt t)))\n    (if o\n        (overlay-get o 'cider-repl-history-target)\n      (unless no-error\n        (error \"No CIDER history item in this buffer\")))))\n\n(defun cider-repl-history-do-insert (_buf pt)\n  \"Helper function to insert text from BUF at PT into the REPL buffer.\nAlso kills *cider-repl-history*.\"\n  ;; Note: as mentioned at the top, this file is based on browse-kill-ring,\n  ;; which has numerous insertion options.  The functionality of\n  ;; browse-kill-ring allows users to insert at point, and move point to the end\n  ;; of the inserted text; or insert at the beginning or end of the buffer,\n  ;; while leaving point alone.  And each of these had the option of leaving the\n  ;; history buffer in place, or getting rid of it.  That was appropriate for a\n  ;; generic paste tool, but for inserting a previous command into an\n  ;; interpreter, I felt the only useful option would be inserting it at the end\n  ;; and quitting the history buffer, so that is all that's provided.\n  (let ((str (cider-repl-history-current-string pt)))\n    (cider-repl-history-quit)\n    (with-selected-window cider-repl-history-repl-window\n      (with-current-buffer cider-repl-history-repl-buffer\n        (let ((max (point-max)))\n          (if (= max (point))\n              (cider-repl-history-insert-and-highlight str)\n            (save-excursion\n              (goto-char max)\n              (cider-repl-history-insert-and-highlight str))))))))\n\n(defun cider-repl-history-insert-and-quit ()\n  \"Insert the item into the REPL buffer, and close *cider-repl-history*.\n\nThe text is always inserted at the very bottom of the REPL buffer.  If your\ncursor is already at the bottom, it is advanced to the end of the inserted\ntext.  If your cursor is somewhere else, the cursor is not moved, but the\ntext is still inserted at the end.\"\n  (interactive)\n  (cider-repl-history-do-insert (current-buffer) (point)))\n\n(defun cider-repl-history-mouse-insert (e)\n  \"Insert the item at E into the REPL buffer, and close *cider-repl-history*.\n\nThe text is always inserted at the very bottom of the REPL buffer.  If your\ncursor is already at the bottom, it is advanced to the end of the inserted\ntext.  If your cursor is somewhere else, the cursor is not moved, but the\ntext is still inserted at the end.\"\n  (interactive \"e\")\n  (let* ((data (save-excursion\n                 (mouse-set-point e)\n                 (cons (current-buffer) (point))))\n         (buf (car data))\n         (pt (cdr data)))\n    (cider-repl-history-do-insert buf pt)))\n\n(defun cider-repl-history-clear-highlighted-entry ()\n  \"Clear the highlighted entry, when one exists.\"\n  (when cider-repl-history-previous-overlay\n    (cl-assert (overlayp cider-repl-history-previous-overlay)\n               nil \"not an overlay\")\n    (overlay-put cider-repl-history-previous-overlay 'face nil)))\n\n(defun cider-repl-history-update-highlighted-entry ()\n  \"Update highlighted entry, when feature is turned on.\"\n  (when cider-repl-history-highlight-current-entry\n    (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t)))\n        (unless (equal cider-repl-history-previous-overlay current-overlay)\n          ;; We've changed overlay.  Clear current highlighting,\n          ;; and highlight the new overlay.\n          (cl-assert (overlay-get current-overlay 'cider-repl-history-target) t)\n          (cider-repl-history-clear-highlighted-entry)\n          (setq cider-repl-history-previous-overlay current-overlay)\n          (overlay-put current-overlay 'face\n                       cider-repl-history-current-entry-face))\n      ;; No overlay at point.  Just clear all current highlighting.\n      (cider-repl-history-clear-highlighted-entry))))\n\n(defun cider-repl-history-forward (&optional arg)\n  \"Move forward by ARG command history entries.\"\n  (interactive \"p\")\n  (beginning-of-line)\n  (while (not (zerop arg))\n    (let ((o (cider-repl-history-target-overlay-at (point) t)))\n      (cond\n       ((>= arg 0)\n        (setq arg (1- arg))\n        ;; We're on a cider-repl-history overlay, skip to the end of it.\n        (when o\n          (goto-char (overlay-end o))\n          (setq o nil))\n        (while (not (or o (eobp)))\n          (goto-char (next-overlay-change (point)))\n          (setq o (cider-repl-history-target-overlay-at (point) t))))\n       (t\n        (setq arg (1+ arg))\n        (when o\n          (goto-char (overlay-start o))\n          (setq o nil))\n        (while (not (or o (bobp)))\n          (goto-char (previous-overlay-change (point)))\n          (setq o (cider-repl-history-target-overlay-at (point) t)))))))\n  (when cider-repl-history-recenter\n    (recenter 1)))\n\n(defun cider-repl-history-previous (&optional arg)\n  \"Move backward by ARG command history entries.\"\n  (interactive \"p\")\n  (cider-repl-history-forward (- arg)))\n\n(defun cider-repl-history-search-forward (regexp &optional backwards)\n  \"Move to the next command history entry matching REGEXP from point.\nIf optional arg BACKWARDS is non-nil, move to the previous matching\nentry.\"\n  (interactive\n   (list (cider-repl-history-read-regexp \"Search forward\" t)\n         current-prefix-arg))\n  (let ((orig (point)))\n    (cider-repl-history-forward (if backwards -1 1))\n    (let ((over (cider-repl-history-target-overlay-at (point) t)))\n      (while (and over\n                  (not (if backwards (bobp) (eobp)))\n                  (not (string-match regexp\n                                     (overlay-get over\n                                                  'cider-repl-history-target))))\n        (cider-repl-history-forward (if backwards -1 1))\n        (setq over (cider-repl-history-target-overlay-at (point) t)))\n      (unless (and over\n                   (string-match regexp\n                                 (overlay-get over\n                                              'cider-repl-history-target)))\n        (goto-char orig)\n        (message \"No more command history entries matching %s\" regexp)))))\n\n(defun cider-repl-history-search-backward (regexp)\n  \"Move to the previous command history entry matching REGEXP from point.\"\n  (interactive\n   (list (cider-repl-history-read-regexp \"Search backward\" t)))\n  (cider-repl-history-search-forward regexp t))\n\n(defun cider-repl-history-elide (str)\n  ;; FIXME: Use `truncate-string-to-width'?\n  \"If STR is too long, abbreviate it with an ellipsis.\nOtherwise, return it unchanged.\"\n  (if (and cider-repl-history-maximum-display-length\n           (> (length str)\n              cider-repl-history-maximum-display-length))\n      (concat (substring str 0 (- cider-repl-history-maximum-display-length 3))\n              (propertize \"...\" 'cider-repl-history-extra t))\n    str))\n\n(defmacro cider-repl-history-add-overlays-for (item &rest body)\n  \"Add overlays for ITEM, and execute BODY.\"\n  (let ((beg (cl-gensym \"cider-repl-history-add-overlays-\"))\n        (end (cl-gensym \"cider-repl-history-add-overlays-\")))\n    `(let ((,beg (point))\n           (,end\n            (progn\n              ,@body\n              (point))))\n       (let ((o (make-overlay ,beg ,end)))\n         (overlay-put o 'cider-repl-history-target ,item)\n         (overlay-put o 'mouse-face 'highlight)))))\n\n(defun cider-repl-history-insert-as-separated (items)\n  \"Insert ITEMS into the current buffer, with separators between items.\"\n  (while items\n    (let* ((origitem (car items))\n           (item (cider-repl-history-elide origitem))\n           ) ;; (len (length item))\n      (cider-repl-history-add-overlays-for origitem (insert item))\n      ;; When the command history has items with read-only text property at\n      ;; **the end of** string, cider-repl-history-setup fails with error\n      ;; `Text is read-only'.  So inhibit-read-only here.\n      ;; See http://bugs.debian.org/225082\n      (let ((inhibit-read-only t))\n        (insert \"\\n\")\n        (when (cdr items)\n          (insert (propertize cider-repl-history-separator\n                              'cider-repl-history-extra t\n                              'cider-repl-history-separator t))\n          (insert \"\\n\"))))\n    (setq items (cdr items))))\n\n(defun cider-repl-history-insert-as-one-line (items)\n  \"Insert ITEMS into the current buffer, formatting each item as a single line.\n\nAn explicit newline character will replace newlines so that the text retains its\nspacing when it's actually inserted into the REPL buffer.\"\n  (dolist (item items)\n    (cider-repl-history-add-overlays-for\n     item\n     (let* ((item (cider-repl-history-elide item))\n            (len (length item))\n            (start 0)\n            (newl (propertize \"\\\\n\" 'cider-repl-history-extra t)))\n       (while (and (< start len)\n                   (string-match \"\\n\" item start))\n         (insert (substring item start (match-beginning 0))\n                 newl)\n         (setq start (match-end 0)))\n       (insert (substring item start len))))\n    (insert \"\\n\")))\n\n(defun cider-repl-history-preview-update-text (preview-text)\n  \"Update `cider-repl-history-preview-overlay' to show `PREVIEW-TEXT`.\"\n  ;; If preview-text is nil, replacement should be nil too.\n  (cl-assert (overlayp cider-repl-history-preview-overlay))\n  (let ((replacement (when preview-text\n                       (propertize preview-text 'face 'highlight))))\n    (overlay-put cider-repl-history-preview-overlay\n                 'before-string replacement)))\n\n(defun cider-repl-history-preview-update-by-position (&optional pt)\n  \"Update `cider-repl-history-preview-overlay' to match item at PT.\n\nThis function is called whenever the selection in the *cider-repl-history*\nbuffer is adjusted, the `cider-repl-history-preview-overlay'\nis updated to preview the text of the selection at PT (or the\ncurrent point if not specified).\"\n  (let ((new-text (cider-repl-history-current-string\n                   (or pt (point)) t)))\n    (cider-repl-history-preview-update-text new-text)))\n\n(defun cider-repl-history-undo-other-window ()\n  \"Undo the most recent change in the other window's buffer.\nYou most likely want to use this command for undoing an insertion of\ntext from the *cider-repl-history* buffer.\"\n  (interactive)\n  (with-current-buffer cider-repl-history-repl-buffer\n    (undo)))\n\n(defun cider-repl-history-setup (repl-win repl-buf history-buf &optional regexp)\n  \"Setup.\nREPL-WIN and REPL-BUF are where to insert commands;\nHISTORY-BUF is the history, and optional arg REGEXP is a filter.\"\n  (cider-repl-history-preview-overlay-setup repl-buf)\n  (with-current-buffer history-buf\n    (unwind-protect\n        (progn\n          (cider-repl-history-mode)\n          (setq buffer-read-only nil)\n          (when (eq 'one-line cider-repl-history-display-style)\n            (setq truncate-lines t))\n          (let ((inhibit-read-only t))\n            (erase-buffer))\n          (setq cider-repl-history-repl-buffer repl-buf)\n          (setq cider-repl-history-repl-window repl-win)\n          (let* ((cider-repl-history-maximum-display-length\n                  (if (and cider-repl-history-maximum-display-length\n                           (<= cider-repl-history-maximum-display-length 3))\n                      4\n                    cider-repl-history-maximum-display-length))\n                 (cider-command-history (cider-repl-history-get-history))\n                 (items (mapcar\n                         (if cider-repl-history-text-properties\n                             #'copy-sequence\n                           #'substring-no-properties)\n                         cider-command-history)))\n            (unless cider-repl-history-display-duplicates\n              ;; display highest or lowest duplicate.\n              ;; if `cider-repl-history-display-duplicate-highest' is t,\n              ;; display highest (most recent) duplicate.\n              (cl-delete-duplicates\n               items\n               :test #'equal\n               :from-end cider-repl-history-display-duplicate-highest))\n            (when (stringp regexp)\n              (setq items (delq nil\n                                (mapcar\n                                 #'(lambda (item)\n                                     (when (string-match regexp item)\n                                       item))\n                                 items))))\n            (funcall (or (cdr (assq cider-repl-history-display-style\n                                    cider-repl-history-display-styles))\n                         (error \"Invalid `cider-repl-history-display-style': %s\"\n                                cider-repl-history-display-style))\n                     items)\n            (when cider-repl-history-show-preview\n              (cider-repl-history-preview-update-by-position (point-min))\n              ;; Local post-command-hook, only happens in *cider-repl-history*\n              (add-hook 'post-command-hook\n                        #'cider-repl-history-preview-update-by-position\n                        nil t)\n              (add-hook 'kill-buffer-hook\n                        #'cider-repl-history-cleanup-on-exit\n                        nil t))\n            (when cider-repl-history-highlight-current-entry\n              (add-hook 'post-command-hook\n                        #'cider-repl-history-update-highlighted-entry\n                        nil t))\n            (message\n             (let ((entry (if (= 1 (length cider-command-history))\n                              \"entry\"\n                            \"entries\")))\n               (concat\n                (if (and (not regexp)\n                         cider-repl-history-display-duplicates)\n                    (format \"%s %s in the command history.\"\n                            (length cider-command-history) entry)\n                  (format \"%s (of %s) %s in the command history shown.\"\n                          (length items) (length cider-command-history) entry))\n                (substitute-command-keys\n                 (concat \"  Type \\\\[cider-repl-history-quit] to quit.  \"\n                         \"\\\\[describe-mode] for help.\")))))\n            (set-buffer-modified-p nil)\n            (goto-char (point-min))\n            (cider-repl-history-forward 0)\n            (setq mode-name (if regexp\n                                (concat \"History [\" regexp \"]\")\n                              \"History\"))\n            (run-hooks 'cider-repl-history-hook)))\n      (setq buffer-read-only t))))\n\n(defun cider-repl-history-update ()\n  \"Update the history buffer to reflect the latest state of the command history.\"\n  (interactive)\n  (cl-assert (eq major-mode 'cider-repl-history-mode))\n  (cider-repl-history-setup cider-repl-history-repl-window\n                            cider-repl-history-repl-buffer\n                            (current-buffer))\n  (cider-repl-history-resize-window))\n\n(defun cider-repl-history-occur (regexp)\n  \"Display all command history entries matching REGEXP.\"\n  (interactive\n   (list (cider-repl-history-read-regexp\n          \"Display command history entries matching\" nil)))\n  (cl-assert (eq major-mode 'cider-repl-history-mode))\n  (cider-repl-history-setup cider-repl-history-repl-window\n                            cider-repl-history-repl-buffer\n                            (current-buffer)\n                            regexp)\n  (cider-repl-history-resize-window))\n\n(defvar cider-repl-history-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"n\")   #'cider-repl-history-forward)\n    (define-key map (kbd \"p\")   #'cider-repl-history-previous)\n    (define-key map (kbd \"SPC\") #'cider-repl-history-insert-and-quit)\n    (define-key map (kbd \"RET\") #'cider-repl-history-insert-and-quit)\n    (define-key map [(mouse-2)] #'cider-repl-history-mouse-insert)\n    (define-key map (kbd \"l\")   #'cider-repl-history-occur)\n    (define-key map (kbd \"s\")   #'cider-repl-history-search-forward)\n    (define-key map (kbd \"r\")   #'cider-repl-history-search-backward)\n    (define-key map (kbd \"g\")   #'cider-repl-history-update)\n    (define-key map (kbd \"q\")   #'cider-repl-history-quit)\n    (define-key map (kbd \"U\")   #'cider-repl-history-undo-other-window)\n    (define-key map (kbd \"?\")   #'describe-mode)\n    (define-key map (kbd \"h\")   #'describe-mode)\n    map))\n\n(put 'cider-repl-history-mode 'mode-class 'special)\n(define-derived-mode cider-repl-history-mode clojure-mode \"History\"\n  \"Major mode for browsing the entries in the command input history.\"\n  (setq-local sesman-system 'CIDER))\n\n;;;###autoload\n(defun cider-repl-history ()\n  \"Display items in the CIDER command history in another buffer.\"\n  (interactive)\n  (when (eq major-mode 'cider-repl-history-mode)\n    (user-error \"Already viewing the CIDER command history\"))\n\n  (let* ((repl-win (selected-window))\n         (repl-buf (window-buffer repl-win))\n         (buf (get-buffer-create cider-repl-history-buffer)))\n    (cider-repl-history-setup repl-win repl-buf buf)\n    (pop-to-buffer buf)\n    (cider-repl-history-resize-window)))\n\n(provide 'cider-repl-history)\n\n;;; cider-repl-history.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-repl.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":53073203,"end":53073240},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":53073240},"to":{"change":3,"start":52993649,"end":52993649},"introduced_by":3}],"inode":{"change":3,"pos":52993649}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52993649},"to":{"change":3,"start":52993650,"end":53073202},"introduced_by":3}],"inode":{"change":3,"pos":52993649}},"content":[{"Del":";;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \n;;         Reid McKenzie \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; This functionality concerns `cider-repl-mode' and REPL interaction.  For\n;; REPL/connection life-cycle management see cider-connection.el.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'easymenu)\n(require 'image)\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'clojure-mode)\n(require 'sesman)\n\n(require 'cider-client)\n(require 'cider-doc)\n(require 'cider-test)\n(require 'cider-eldoc) ; for cider-eldoc-setup\n(require 'cider-common)\n(require 'cider-util)\n(require 'cider-resolve)\n\n(declare-function cider-inspect \"cider-inspector\")\n\n\f\n(defgroup cider-repl nil\n  \"Interaction with the REPL.\"\n  :prefix \"cider-repl-\"\n  :group 'cider)\n\n(defface cider-repl-prompt-face\n  '((t (:inherit font-lock-keyword-face)))\n  \"Face for the prompt in the REPL buffer.\")\n\n(defface cider-repl-stdout-face\n  '((t (:inherit font-lock-string-face)))\n  \"Face for STDOUT output in the REPL buffer.\")\n\n(defface cider-repl-stderr-face\n  '((t (:inherit font-lock-warning-face)))\n  \"Face for STDERR output in the REPL buffer.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-repl-input-face\n  '((t (:bold t)))\n  \"Face for previous input in the REPL buffer.\")\n\n(defface cider-repl-result-face\n  '((t ()))\n  \"Face for the result of an evaluation in the REPL buffer.\")\n\n(defcustom cider-repl-pop-to-buffer-on-connect t\n  \"Controls whether to pop to the REPL buffer on connect.\n\nWhen set to nil the buffer will only be created, and not displayed.  When\nset to `display-only' the buffer will be displayed, but it will not become\nfocused.  Otherwise the buffer is displayed and focused.\"\n  :type '(choice (const :tag \"Create the buffer, but don't display it\" nil)\n                 (const :tag \"Create and display the buffer, but don't focus it\"\n                        display-only)\n                 (const :tag \"Create, display, and focus the buffer\" t)))\n\n(defcustom cider-repl-display-in-current-window nil\n  \"Controls whether the REPL buffer is displayed in the current window.\"\n  :type 'boolean)\n\n(make-obsolete-variable 'cider-repl-scroll-on-output 'scroll-conservatively \"0.21\")\n\n(defcustom cider-repl-use-pretty-printing t\n  \"Control whether results in the REPL are pretty-printed or not.\nThe REPL will use the printer specified in `cider-print-fn'.\nThe `cider-toggle-pretty-printing' command can be used to interactively\nchange the setting's value.\"\n  :type 'boolean)\n\n(make-obsolete-variable 'cider-repl-pretty-print-width 'cider-print-options \"0.21\")\n\n(defcustom cider-repl-use-content-types nil\n  \"Control whether REPL results are presented using content-type information.\nThe `cider-repl-toggle-content-types' command can be used to interactively\nchange the setting's value.\"\n  :type 'boolean\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-repl-auto-detect-type t\n  \"Control whether to auto-detect the REPL type using track-state information.\nIf you disable this you'll have to manually change the REPL type between\nClojure and ClojureScript when invoking REPL type changing forms.\nUse `cider-set-repl-type' to manually change the REPL type.\"\n  :type 'boolean\n  :safe #'booleanp\n  :package-version '(cider . \"0.18.0\"))\n\n(defcustom cider-repl-use-clojure-font-lock t\n  \"Non-nil means to use Clojure mode font-locking for input and result.\nNil means that `cider-repl-input-face' and `cider-repl-result-face'\nwill be used.\"\n  :type 'boolean\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-repl-require-ns-on-set nil\n  \"Controls whether to require the ns before setting it in the REPL.\"\n  :type 'boolean\n  :package-version '(cider . \"0.22.0\"))\n\n(defcustom cider-repl-result-prefix \"\"\n  \"The prefix displayed in the REPL before a result value.\nBy default there's no prefix, but you can specify something\nlike \\\"=>\\\" if want results to stand out more.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.5.0\"))\n\n(defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol\n  \"Select the command to be invoked by the TAB key.\nThe default option is `cider-repl-indent-and-complete-symbol'.  If\nyou'd like to use the default Emacs behavior use\n`indent-for-tab-command'.\"\n  :type 'symbol)\n\n(make-obsolete-variable 'cider-repl-print-length 'cider-print-options \"0.21\")\n(make-obsolete-variable 'cider-repl-print-level 'cider-print-options \"0.21\")\n\n(defvar cider-repl-require-repl-utils-code\n  '((clj . \"(clojure.core/apply clojure.core/require clojure.main/repl-requires)\")\n    (cljs . \"(require '[cljs.repl :refer [apropos dir doc find-doc print-doc pst source]])\")))\n\n(defcustom cider-repl-init-code (list (cdr (assoc 'clj cider-repl-require-repl-utils-code)))\n  \"Clojure code to evaluate when starting a REPL.\nWill be evaluated with bindings for set!-able vars in place.\"\n  :type '(list string)\n  :package-version '(cider . \"0.21.0\"))\n\n(defcustom cider-repl-display-help-banner t\n  \"When non-nil a bit of help text will be displayed on REPL start.\"\n  :type 'boolean\n  :package-version '(cider . \"0.11.0\"))\n\n\f\n;;;; REPL buffer local variables\n(defvar-local cider-repl-input-start-mark nil)\n\n(defvar-local cider-repl-prompt-start-mark nil)\n\n(defvar-local cider-repl-old-input-counter 0\n  \"Counter used to generate unique `cider-old-input' properties.\nThis property value must be unique to avoid having adjacent inputs be\njoined together.\")\n\n(defvar-local cider-repl-input-history '()\n  \"History list of strings read from the REPL buffer.\")\n\n(defvar-local cider-repl-input-history-items-added 0\n  \"Variable counting the items added in the current session.\")\n\n(defvar-local cider-repl-output-start nil\n  \"Marker for the start of output.\nCurrently its only purpose is to facilitate `cider-repl-clear-buffer'.\")\n\n(defvar-local cider-repl-output-end nil\n  \"Marker for the end of output.\nCurrently its only purpose is to facilitate `cider-repl-clear-buffer'.\")\n\n(defun cider-repl-tab ()\n  \"Invoked on TAB keystrokes in `cider-repl-mode' buffers.\"\n  (interactive)\n  (funcall cider-repl-tab-command))\n\n(defun cider-repl-reset-markers ()\n  \"Reset all REPL markers.\"\n  (dolist (markname '(cider-repl-output-start\n                      cider-repl-output-end\n                      cider-repl-prompt-start-mark\n                      cider-repl-input-start-mark))\n    (set markname (make-marker))\n    (set-marker (symbol-value markname) (point))))\n\n\f\n;;; REPL init\n\n(defvar-local cider-repl-ns-cache nil\n  \"A dict holding information about all currently loaded namespaces.\nThis cache is stored in the connection buffer.\")\n\n(defvar cider-mode)\n(declare-function cider-refresh-dynamic-font-lock \"cider-mode\")\n\n(defun cider-repl--state-handler (response)\n  \"Handle server state contained in RESPONSE.\"\n  (with-demoted-errors \"Error in `cider-repl--state-handler': %s\"\n    (when (member \"state\" (nrepl-dict-get response \"status\"))\n      (nrepl-dbind-response response (repl-type changed-namespaces)\n        (when (and repl-type cider-repl-auto-detect-type)\n          (cider-set-repl-type repl-type))\n        (unless (nrepl-dict-empty-p changed-namespaces)\n          (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces))\n          (dolist (b (buffer-list))\n            (with-current-buffer b\n              ;; Metadata changed, so signatures may have changed too.\n              (setq cider-eldoc-last-symbol nil)\n              (when (or cider-mode (derived-mode-p 'cider-repl-mode))\n                (when-let* ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns))\n                                         (let ((ns-dict (cider-resolve--get-in (cider-current-ns))))\n                                           (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns))\n                                                           (nrepl-dict-get ns-dict \"aliases\"))\n                                             ns-dict)))))\n                  (cider-refresh-dynamic-font-lock ns-dict))))))))))\n\n(defun cider-repl-require-repl-utils ()\n  \"Require standard REPL util functions into the current REPL.\"\n  (interactive)\n  (let* ((current-repl (cider-current-repl nil 'ensure))\n         (require-code (cdr (assoc (cider-repl-type current-repl) cider-repl-require-repl-utils-code))))\n    (nrepl-send-sync-request\n     (lax-plist-put\n      (nrepl--eval-request require-code (cider-current-ns))\n      \"inhibit-cider-middleware\" \"true\")\n     current-repl)))\n\n(defun cider-repl-init-eval-handler (&optional callback)\n  \"Make an nREPL evaluation handler for use during REPL init.\nRun CALLBACK once the evaluation is complete.\"\n  (nrepl-make-response-handler (current-buffer)\n                               (lambda (_buffer _value))\n                               (lambda (buffer out)\n                                 (cider-repl-emit-stdout buffer out))\n                               (lambda (buffer err)\n                                 (cider-repl-emit-stderr buffer err))\n                               (lambda (buffer)\n                                 (cider-repl-emit-prompt buffer)\n                                 (when callback\n                                   (funcall callback)))))\n\n(defun cider-repl-eval-init-code (&optional callback)\n  \"Evaluate `cider-repl-init-code' in the current REPL.\nRun CALLBACK once the evaluation is complete.\"\n  (interactive)\n  (let* ((request (map-merge 'hash-table\n                             (cider--repl-request-map fill-column)\n                             '((\"inhibit-cider-middleware\" \"true\")))))\n    (cider-nrepl-request:eval\n     ;; Ensure we evaluate _something_ so the initial namespace is correctly set\n     (thread-first (or cider-repl-init-code '(\"nil\"))\n                   (string-join \"\\n\"))\n     (cider-repl-init-eval-handler callback)\n     nil\n     (line-number-at-pos (point))\n     (cider-column-number-at-pos (point))\n     (thread-last\n       request\n       (map-pairs)\n       (seq-mapcat #'identity)))))\n\n(defun cider-repl-init (buffer &optional callback)\n  \"Initialize the REPL in BUFFER.\nBUFFER must be a REPL buffer with `cider-repl-mode' and a running\nclient process connection.  CALLBACK will be run once the REPL is\nfully initialized.\"\n  (when cider-repl-display-in-current-window\n    (add-to-list 'same-window-buffer-names (buffer-name buffer)))\n  (pcase cider-repl-pop-to-buffer-on-connect\n    (`display-only\n     (let ((orig-buffer (current-buffer)))\n       (display-buffer buffer)\n       ;; User popup-rules (specifically `:select nil') can cause the call to\n       ;; `display-buffer' to reset the current Emacs buffer to the clj/cljs\n       ;; buffer that the user ran `jack-in' from - we need the current-buffer\n       ;; to be the repl to initialize, so reset it back here to be resilient\n       ;; against user config\n       (set-buffer orig-buffer)))\n    ((pred identity) (pop-to-buffer buffer)))\n  (with-current-buffer buffer\n    (cider-repl--insert-banner)\n    (cider-repl--insert-startup-commands)\n    (when-let* ((window (get-buffer-window buffer t)))\n      (with-selected-window window\n        (recenter (- -1 scroll-margin))))\n    (cider-repl-eval-init-code callback))\n  buffer)\n\n(defun cider-repl--insert-banner ()\n  \"Insert the banner in the current REPL buffer.\"\n  (insert-before-markers\n   (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face))\n  (when cider-repl-display-help-banner\n    (insert-before-markers\n     (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face))))\n\n(defun cider-repl--insert-startup-commands ()\n  \"Insert the values from params specified in PARAM-TUPLES.\nPARAM-TUPLES are tuples of (param-key description) or (param-key\ndescription transform) where transform is called with the param-value if\npresent.\"\n  (cl-labels\n      ((emit-comment\n        (contents)\n        (insert-before-markers\n         (propertize\n          (if (string-blank-p contents) \";;\\n\" (concat \";; \" contents \"\\n\"))\n          'font-lock-face 'font-lock-comment-face))))\n    (let ((jack-in-command (plist-get cider-launch-params :jack-in-cmd))\n          (cljs-repl-type (plist-get cider-launch-params :cljs-repl-type))\n          (cljs-init-form (plist-get cider-launch-params :repl-init-form)))\n      (when jack-in-command\n        ;; spaces to align with the banner\n        (emit-comment (concat \" Startup: \" jack-in-command)))\n      (when (or cljs-repl-type cljs-init-form)\n        (emit-comment \"\")\n        (when cljs-repl-type\n          (emit-comment (concat \"ClojureScript REPL type: \" (symbol-name cljs-repl-type))))\n        (when cljs-init-form\n          (emit-comment (concat \"ClojureScript REPL init form: \" cljs-init-form)))\n        (emit-comment \"\")))))\n\n(defun cider-repl--banner ()\n  \"Generate the welcome REPL buffer banner.\"\n  (cond\n   ((cider--clojure-version) (cider-repl--clojure-banner))\n   ((cider--babashka-version) (cider-repl--babashka-banner))\n   (t (cider-repl--basic-banner))))\n\n(defun cider-repl--clojure-banner ()\n  \"Generate the welcome REPL buffer banner for Clojure(Script).\"\n  (format \";; Connected to nREPL server - nrepl://%s:%s\n;; CIDER %s, nREPL %s\n;; Clojure %s, Java %s\n;;     Docs: (doc function-name)\n;;           (find-doc part-of-name)\n;;   Source: (source function-name)\n;;  Javadoc: (javadoc java-object-or-class)\n;;     Exit: \n;;  Results: Stored in vars *1, *2, *3, an exception in *e;\n\"\n          (plist-get nrepl-endpoint :host)\n          (plist-get nrepl-endpoint :port)\n          (cider--version)\n          (cider--nrepl-version)\n          (cider--clojure-version)\n          (cider--java-version)))\n\n(defun cider-repl--babashka-banner ()\n  \"Generate the welcome REPL buffer banner for Babashka.\"\n  (format \";; Connected to nREPL server - nrepl://%s:%s\n;; CIDER %s, babashka.nrepl %s\n;; Babashka %s\n;;     Docs: (doc function-name)\n;;           (find-doc part-of-name)\n;;   Source: (source function-name)\n;;  Javadoc: (javadoc java-object-or-class)\n;;     Exit: \n;;  Results: Stored in vars *1, *2, *3, an exception in *e;\n\"\n          (plist-get nrepl-endpoint :host)\n          (plist-get nrepl-endpoint :port)\n          (cider--version)\n          (cider--babashka-nrepl-version)\n          (cider--babashka-version)))\n\n(defun cider-repl--basic-banner ()\n  \"Generate a basic banner with minimal info.\"\n  (format \";; Connected to nREPL server - nrepl://%s:%s\n;; CIDER %s\n\"\n          (plist-get nrepl-endpoint :host)\n          (plist-get nrepl-endpoint :port)\n          (cider--version)))\n\n(defun cider-repl--help-banner ()\n  \"Generate the help banner.\"\n  (substitute-command-keys\n   \";; ======================================================================\n;; If you're new to CIDER it is highly recommended to go through its\n;; user manual first. Type  to view it.\n;; In case you're seeing any warnings you should consult the manual's\n;; \\\"Troubleshooting\\\" section.\n;;\n;; Here are a few tips to get you started:\n;;\n;; * Press <\\\\[describe-mode]> to see a list of the keybindings available (this\n;;   will work in every Emacs buffer)\n;; * Press <\\\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command\n;; * Press <\\\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure file\n;; * Press <\\\\[cider-find-var]> to jump to the source of something (e.g. a var, a\n;;   Java method)\n;; * Press <\\\\[cider-doc]> to view the documentation for something (e.g.\n;;   a var, a Java method)\n;; * Print CIDER's refcard and keep it close to your keyboard.\n;;\n;; CIDER is super customizable - try  to\n;; get a feel for this. If you're thirsty for knowledge you should try\n;; .\n;;\n;; If you think you've encountered a bug (or have some suggestions for\n;; improvements) use  to report it.\n;;\n;; Above all else - don't panic! In case of an emergency - procure\n;; some (hard) cider and enjoy it responsibly!\n;;\n;; You can remove this message with the  command.\n;; You can disable it from appearing on start by setting\n;; `cider-repl-display-help-banner' to nil.\n;; ======================================================================\n\"))\n\n\f\n;;; REPL interaction\n\n(defun cider-repl--in-input-area-p ()\n  \"Return t if in input area.\"\n  (<= cider-repl-input-start-mark (point)))\n\n(defun cider-repl--current-input (&optional until-point-p)\n  \"Return the current input as string.\nThe input is the region from after the last prompt to the end of\nbuffer.  If UNTIL-POINT-P is non-nil, the input is until the current\npoint.\"\n  (buffer-substring-no-properties cider-repl-input-start-mark\n                                  (if until-point-p\n                                      (point)\n                                    (point-max))))\n\n(defun cider-repl-previous-prompt ()\n  \"Move backward to the previous prompt.\"\n  (interactive)\n  (cider-repl--find-prompt t))\n\n(defun cider-repl-next-prompt ()\n  \"Move forward to the next prompt.\"\n  (interactive)\n  (cider-repl--find-prompt))\n\n(defun cider-repl--find-prompt (&optional backward)\n  \"Find the next prompt.\nIf BACKWARD is non-nil look backward.\"\n  (let ((origin (point))\n        (cider-repl-prompt-property 'field))\n    (while (progn\n             (cider-search-property-change cider-repl-prompt-property backward)\n             (not (or (cider-end-of-proprange-p cider-repl-prompt-property) (bobp) (eobp)))))\n    (unless (cider-end-of-proprange-p cider-repl-prompt-property)\n      (goto-char origin))))\n\n(defun cider-search-property-change (prop &optional backward)\n  \"Search forward for a property change to PROP.\nIf BACKWARD is non-nil search backward.\"\n  (cond (backward\n         (goto-char (previous-single-char-property-change (point) prop)))\n        (t\n         (goto-char (next-single-char-property-change (point) prop)))))\n\n(defun cider-end-of-proprange-p (property)\n  \"Return t if at the the end of a property range for PROPERTY.\"\n  (and (get-char-property (max (point-min) (1- (point))) property)\n       (not (get-char-property (point) property))))\n\n(defun cider-repl--mark-input-start ()\n  \"Mark the input start.\"\n  (set-marker cider-repl-input-start-mark (point) (current-buffer)))\n\n(defun cider-repl--mark-output-start ()\n  \"Mark the output start.\"\n  (set-marker cider-repl-output-start (point))\n  (set-marker cider-repl-output-end (point)))\n\n(defun cider-repl-mode-beginning-of-defun (&optional arg)\n  \"Move to the beginning of defun.\nIf given a negative value of ARG, move to the end of defun.\"\n  (if (and arg (< arg 0))\n      (cider-repl-mode-end-of-defun (- arg))\n    (dotimes (_ (or arg 1))\n      (cider-repl-previous-prompt))))\n\n(defun cider-repl-mode-end-of-defun (&optional arg)\n  \"Move to the end of defun.\nIf given a negative value of ARG, move to the beginning of defun.\"\n  (if (and arg (< arg 0))\n      (cider-repl-mode-beginning-of-defun (- arg))\n    (dotimes (_ (or arg 1))\n      (cider-repl-next-prompt))))\n\n(defun cider-repl-beginning-of-defun ()\n  \"Move to beginning of defun.\"\n  (interactive)\n  ;; We call `beginning-of-defun' if we're at the start of a prompt\n  ;; already, to trigger `cider-repl-mode-beginning-of-defun' by means\n  ;; of the locally bound `beginning-of-defun-function', in order to\n  ;; jump to the start of the previous prompt.\n  (if (and (not (cider-repl--at-prompt-start-p))\n           (cider-repl--in-input-area-p))\n      (goto-char cider-repl-input-start-mark)\n    (beginning-of-defun)))\n\n(defun cider-repl-end-of-defun ()\n  \"Move to end of defun.\"\n  (interactive)\n  ;; C.f. `cider-repl-beginning-of-defun'\n  (if (and (not (= (point) (point-max)))\n           (cider-repl--in-input-area-p))\n      (goto-char (point-max))\n    (end-of-defun)))\n\n(defun cider-repl-bol-mark ()\n  \"Set the mark and go to the beginning of line or the prompt.\"\n  (interactive)\n  (unless mark-active\n    (set-mark (point)))\n  (move-beginning-of-line 1))\n\n(defun cider-repl--at-prompt-start-p ()\n  \"Return t if point is at the start of prompt.\nThis will not work on non-current prompts.\"\n  (= (point) cider-repl-input-start-mark))\n\n(defmacro cider-save-marker (marker &rest body)\n  \"Save MARKER and execute BODY.\"\n  (declare (debug t))\n  (let ((pos (make-symbol \"pos\")))\n    `(let ((,pos (marker-position ,marker)))\n       (prog1 (progn . ,body)\n         (set-marker ,marker ,pos)))))\n\n(put 'cider-save-marker 'lisp-indent-function 1)\n\n(defun cider-repl-prompt-default (namespace)\n  \"Return a prompt string that mentions NAMESPACE.\"\n  (format \"%s> \" namespace))\n\n(defun cider-repl-prompt-abbreviated (namespace)\n  \"Return a prompt string that abbreviates NAMESPACE.\"\n  (format \"%s> \" (cider-abbreviate-ns namespace)))\n\n(defun cider-repl-prompt-lastname (namespace)\n  \"Return a prompt string with the last name in NAMESPACE.\"\n  (format \"%s> \" (cider-last-ns-segment namespace)))\n\n(defcustom cider-repl-prompt-function #'cider-repl-prompt-default\n  \"A function that returns a prompt string.\nTakes one argument, a namespace name.\nFor convenience, three functions are already provided for this purpose:\n`cider-repl-prompt-lastname', `cider-repl-prompt-abbreviated', and\n`cider-repl-prompt-default'.\"\n  :type '(choice (const :tag \"Full namespace\" cider-repl-prompt-default)\n                 (const :tag \"Abbreviated namespace\" cider-repl-prompt-abbreviated)\n                 (const :tag \"Last name in namespace\" cider-repl-prompt-lastname)\n                 (function :tag \"Custom function\"))\n  :package-version '(cider . \"0.9.0\"))\n\n(defun cider-repl--insert-prompt (namespace)\n  \"Insert the prompt (before markers!), taking into account NAMESPACE.\nSet point after the prompt.\nReturn the position of the prompt beginning.\"\n  (goto-char cider-repl-input-start-mark)\n  (cider-save-marker cider-repl-output-start\n    (cider-save-marker cider-repl-output-end\n      (unless (bolp) (insert-before-markers \"\\n\"))\n      (let ((prompt-start (point))\n            (prompt (funcall cider-repl-prompt-function namespace)))\n        (cider-propertize-region\n            '(font-lock-face cider-repl-prompt-face read-only t intangible t\n                             field cider-repl-prompt\n                             rear-nonsticky (field read-only font-lock-face intangible))\n          (insert-before-markers prompt))\n        (set-marker cider-repl-prompt-start-mark prompt-start)\n        prompt-start))))\n\n(defun cider-repl--ansi-color-apply (string)\n  \"Like `ansi-color-apply', but does not withhold non-SGR seqs found in STRING.\n\nWorkaround for Emacs bug#53808 whereby partial ANSI control seqs present in\nthe input stream may block the whole colorization process.\"\n  (let* ((result (ansi-color-apply string))\n\n         ;; The STRING may end with a possible incomplete ANSI control seq which\n         ;; the call to `ansi-color-apply' stores in the `ansi-color-context'\n         ;; fragment. If the fragment is not an incomplete ANSI color control\n         ;; sequence (aka SGR seq) though then flush it out and appended it to\n         ;; the result.\n         (fragment-flush?\n          (when-let (fragment (and ansi-color-context (cadr ansi-color-context)))\n            (save-match-data\n              ;; Check if fragment is indeed an SGR seq in the making. The SGR\n              ;; seq is defined as starting with ESC followed by [ followed by\n              ;; zero or more [:digit:]+; followed by one or more digits and\n              ;; ending with m.\n              (when (string-match\n                     (rx (sequence ?\\e\n                                   (? (and (or ?\\[ eol)\n                                           (or (+ (any (?0 . ?9))) eol)\n                                           (* (sequence ?\\; (+ (any (?0 . ?9)))))\n                                           (or ?\\; eol)))))\n                     fragment)\n                (let* ((sgr-end-pos (match-end 0))\n                       (fragment-matches-whole? (or (= sgr-end-pos 0)\n                                                    (= sgr-end-pos (length fragment)))))\n                  (when (not fragment-matches-whole?)\n                    ;; Definitely not an partial SGR seq, flush it out of\n                    ;; `ansi-color-context'.\n                    t)))))))\n\n    (if (not fragment-flush?)\n        result\n\n      (progn\n        ;; Temporarily replace the ESC char in the fragment so that is flushed\n        ;; out of `ansi-color-context' by `ansi-color-apply' and append it to\n        ;; the result.\n        (aset (cadr ansi-color-context) 0 ?\\0)\n        (let ((result-fragment (ansi-color-apply \"\")))\n          (aset result-fragment 0 ?\\e)\n          (concat result result-fragment))))))\n\n(defvar-local cider-repl--ns-forms-plist nil\n  \"Plist holding ns->ns-form mappings within each connection.\")\n\n(defun cider-repl--ns-form-changed-p (ns-form connection)\n  \"Return non-nil if NS-FORM for CONNECTION changed since last eval.\"\n  (when-let* ((ns (cider-ns-from-form ns-form)))\n    (not (string= ns-form\n                  (lax-plist-get\n                   (buffer-local-value 'cider-repl--ns-forms-plist connection)\n                   ns)))))\n\n(defvar cider-repl--root-ns-highlight-template \"\\\\_<\\\\(%s\\\\)[^$/: \\t\\n()]+\"\n  \"Regexp used to highlight root ns in REPL buffers.\")\n\n(defvar-local cider-repl--root-ns-regexp nil\n  \"Cache of root ns regexp in REPLs.\")\n\n(defvar-local cider-repl--ns-roots nil\n  \"List holding all past root namespaces seen during interactive eval.\")\n\n(defun cider-repl--cache-ns-form (ns-form connection)\n  \"Given NS-FORM cache root ns in CONNECTION.\"\n  (with-current-buffer connection\n    (when-let* ((ns (cider-ns-from-form ns-form)))\n      ;; cache ns-form\n      (setq cider-repl--ns-forms-plist\n            (lax-plist-put cider-repl--ns-forms-plist ns ns-form))\n      ;; cache ns roots regexp\n      (when (string-match \"\\\\([^.]+\\\\)\" ns)\n        (let ((root (match-string-no-properties 1 ns)))\n          (unless (member root cider-repl--ns-roots)\n            (push root cider-repl--ns-roots)\n            (let ((roots (mapconcat\n                          ;; Replace _ or - with regexp pattern to accommodate \"raw\" namespaces\n                          (lambda (r) (replace-regexp-in-string \"[_-]+\" \"[_-]+\" r))\n                          cider-repl--ns-roots \"\\\\|\")))\n              (setq cider-repl--root-ns-regexp\n                    (format cider-repl--root-ns-highlight-template roots)))))))))\n\n(defvar cider-repl-spec-keywords-regexp\n  (concat\n   (regexp-opt '(\"In:\" \" val:\"\n                 \" at:\" \"fails at:\"\n                 \" spec:\" \"fails spec:\"\n                 \" predicate:\" \"fails predicate:\"))\n   \"\\\\|^\"\n   (regexp-opt '(\":clojure.spec.alpha/spec\"\n                 \":clojure.spec.alpha/value\")\n               \"\\\\(\"))\n  \"Regexp matching clojure.spec `explain` keywords.\")\n\n(defun cider-repl-highlight-spec-keywords (string)\n  \"Highlight clojure.spec `explain` keywords in STRING.\nForeground of `clojure-keyword-face' is used for highlight.\"\n  (cider-add-face cider-repl-spec-keywords-regexp\n                  'clojure-keyword-face t nil string)\n  string)\n\n(defun cider-repl-highlight-current-project (string)\n  \"Fontify project's root namespace to make stacktraces more readable.\nForeground of `cider-stacktrace-ns-face' is used to propertize matched\nnamespaces.  STRING is REPL's output.\"\n  (cider-add-face cider-repl--root-ns-regexp 'cider-stacktrace-ns-face\n                  t nil string)\n  string)\n\n(defun cider-repl-add-locref-help-echo (string)\n  \"Set help-echo property of STRING to `cider-locref-help-echo'.\"\n  (put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo string)\n  string)\n\n(defvar cider-repl-preoutput-hook `(,(if (< emacs-major-version 29)\n                                         'cider-repl--ansi-color-apply\n                                       'ansi-color-apply)\n                                    cider-repl-highlight-current-project\n                                    cider-repl-highlight-spec-keywords\n                                    cider-repl-add-locref-help-echo)\n  \"Hook run on output string before it is inserted into the REPL buffer.\nEach functions takes a string and must return a modified string.  Also see\n`cider-run-chained-hook'.\")\n\n(defcustom cider-repl-buffer-size-limit nil\n  \"The max size of the REPL buffer.\nSetting this to nil removes the limit.\"\n  :group 'cider\n  :type 'integer\n  :package-version '(cider . \"0.26.0\"))\n\n(defun cider-start-of-next-prompt (point)\n  \"Return the position of the first char of the next prompt from POINT.\"\n  (let ((next-prompt-or-input (next-single-char-property-change point 'field)))\n    (if (eq (get-char-property next-prompt-or-input 'field) 'cider-repl-prompt)\n        next-prompt-or-input\n      (next-single-char-property-change next-prompt-or-input 'field))))\n\n(defun cider-repl-trim-top-of-buffer (buffer)\n  \"Trims REPL output from beginning of BUFFER.\nTrims by one fifth of `cider-repl-buffer-size-limit'.\nAlso clears remaining partial input or results.\"\n  (with-current-buffer buffer\n    (let* ((to-trim (ceiling (* cider-repl-buffer-size-limit 0.2)))\n           (start-of-next-prompt (cider-start-of-next-prompt to-trim))\n           (inhibit-read-only t))\n      (cider-repl--clear-region (point-min) start-of-next-prompt))))\n\n(defun cider-repl-trim-buffer ()\n  \"Trim the currently visited REPL buffer partially from the top.\nSee also `cider-repl-clear-buffer'.\"\n  (interactive)\n  (if cider-repl-buffer-size-limit\n      (cider-repl-trim-top-of-buffer (current-buffer))\n    (user-error \"The variable `cider-repl-buffer-size-limit' is not set\")))\n\n(defun cider-repl-maybe-trim-buffer (buffer)\n  \"Clear portion of printed output in BUFFER.\nClear the part where `cider-repl-buffer-size-limit' is exceeded.\"\n  (when (> (buffer-size) cider-repl-buffer-size-limit)\n    (cider-repl-trim-top-of-buffer buffer)))\n\n(defun cider-repl--emit-output (buffer string face)\n  \"Using BUFFER, emit STRING as output font-locked using FACE.\nBefore inserting, run `cider-repl-preoutput-hook' on STRING.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (cider-save-marker cider-repl-output-start\n        (goto-char cider-repl-output-end)\n        (setq string (propertize string\n                                 'font-lock-face face\n                                 'rear-nonsticky '(font-lock-face)))\n        (setq string (cider-run-chained-hook 'cider-repl-preoutput-hook string))\n        (insert-before-markers string))\n      (when (and (= (point) cider-repl-prompt-start-mark)\n                 (not (bolp)))\n        (insert-before-markers \"\\n\")\n        (set-marker cider-repl-output-end (1- (point))))))\n  (when-let* ((window (get-buffer-window buffer t)))\n    ;; If the prompt is on the first line of the window, then scroll the window\n    ;; down by a single line to make the emitted output visible.\n    (when (and (pos-visible-in-window-p cider-repl-prompt-start-mark window)\n               (< 1 cider-repl-prompt-start-mark)\n               (not (pos-visible-in-window-p (1- cider-repl-prompt-start-mark) window)))\n      (with-selected-window window\n        (scroll-down 1)))))\n\n(defun cider-repl--emit-interactive-output (string face)\n  \"Emit STRING as interactive output using FACE.\"\n  (cider-repl--emit-output (cider-current-repl) string face))\n\n(defun cider-repl-emit-interactive-stdout (string)\n  \"Emit STRING as interactive output.\"\n  (cider-repl--emit-interactive-output string 'cider-repl-stdout-face))\n\n(defun cider-repl-emit-interactive-stderr (string)\n  \"Emit STRING as interactive err output.\"\n  (cider-repl--emit-interactive-output string 'cider-repl-stderr-face))\n\n(defun cider-repl-emit-stdout (buffer string)\n  \"Using BUFFER, emit STRING as standard output.\"\n  (cider-repl--emit-output buffer string 'cider-repl-stdout-face))\n\n(defun cider-repl-emit-stderr (buffer string)\n  \"Using BUFFER, emit STRING as error output.\"\n  (cider-repl--emit-output buffer string 'cider-repl-stderr-face))\n\n(defun cider-repl-emit-prompt (buffer)\n  \"Emit the REPL prompt into BUFFER.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (cider-repl--insert-prompt cider-buffer-ns))))\n\n(defun cider-repl-emit-result (buffer string show-prefix &optional bol)\n  \"Emit into BUFFER the result STRING and mark it as an evaluation result.\nIf SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning\nof the line.  If BOL is non-nil insert at the beginning of the line.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (cider-save-marker cider-repl-output-start\n        (goto-char cider-repl-output-end)\n        (when (and bol (not (bolp)))\n          (insert-before-markers \"\\n\"))\n        (when show-prefix\n          (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face)))\n        (if cider-repl-use-clojure-font-lock\n            (insert-before-markers (cider-font-lock-as-clojure string))\n          (cider-propertize-region\n              '(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face))\n            (insert-before-markers string)))))))\n\n(defun cider-repl-newline-and-indent ()\n  \"Insert a newline, then indent the next line.\nRestrict the buffer from the prompt for indentation, to avoid being\nconfused by strange characters (like unmatched quotes) appearing\nearlier in the buffer.\"\n  (interactive)\n  (save-restriction\n    (narrow-to-region cider-repl-prompt-start-mark (point-max))\n    (insert \"\\n\")\n    (lisp-indent-line)))\n\n(defun cider-repl-indent-and-complete-symbol ()\n  \"Indent the current line and perform symbol completion.\nFirst indent the line.  If indenting doesn't move point, complete\nthe symbol.\"\n  (interactive)\n  (let ((pos (point)))\n    (lisp-indent-line)\n    (when (= pos (point))\n      (if (save-excursion (re-search-backward \"[^() \\n\\t\\r]+\\\\=\" nil t))\n          (completion-at-point)))))\n\n(defun cider-repl-kill-input ()\n  \"Kill all text from the prompt to point.\"\n  (interactive)\n  (cond ((< (marker-position cider-repl-input-start-mark) (point))\n         (kill-region cider-repl-input-start-mark (point)))\n        ((= (point) (marker-position cider-repl-input-start-mark))\n         (cider-repl-delete-current-input))))\n\n(defun cider-repl--input-complete-p (start end)\n  \"Return t if the region from START to END is a complete sexp.\"\n  (save-excursion\n    (goto-char start)\n    (cond ((looking-at-p \"\\\\s *[@'`#]?[(\\\"]\")\n           (ignore-errors\n             (save-restriction\n               (narrow-to-region start end)\n               ;; Keep stepping over blanks and sexps until the end of\n               ;; buffer is reached or an error occurs. Tolerate extra\n               ;; close parens.\n               (cl-loop do (skip-chars-forward \" \\t\\r\\n)\")\n                        until (eobp)\n                        do (forward-sexp))\n               t)))\n          (t t))))\n\n(defun cider-repl--display-image (buffer image &optional show-prefix bol)\n  \"Insert IMAGE into BUFFER at the current point.\n\nFor compatibility with the rest of CIDER's REPL machinery, supports\nSHOW-PREFIX and BOL.\"\n  (with-current-buffer buffer\n    (save-excursion\n      (cider-save-marker cider-repl-output-start\n        (goto-char cider-repl-output-end)\n        (when (and bol (not (bolp)))\n          (insert-before-markers \"\\n\"))\n        (when show-prefix\n          (insert-before-markers\n           (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face)))\n        ;; The below is inlined from `insert-image' and changed to use\n        ;; `insert-before-markers' rather than `insert'\n        (let ((start (point))\n              (props (nconc `(display ,image rear-nonsticky (display))\n                            (when (boundp 'image-map)\n                              `(keymap ,image-map)))))\n          (insert-before-markers \" \")\n          (add-text-properties start (point) props)))))\n  t)\n\n(defcustom cider-repl-image-margin 10\n  \"Specifies the margin to be applied to images displayed in the REPL.\nEither a single number of pixels - interpreted as a symmetric margin, or\npair of numbers `(x . y)' encoding an arbitrary margin.\"\n  :type '(choice integer (vector integer integer))\n  :package-version '(cider . \"0.17.0\"))\n\n(defun cider-repl--image (data type datap)\n  \"A helper for creating images with CIDER's image options.\nDATA is either the path to an image or its base64 coded data.  TYPE is a\nsymbol indicating the image type.  DATAP indicates whether the image is the\nraw image data or a filename.  Returns an image instance with a margin per\n`cider-repl-image-margin'.\"\n  (create-image data type datap\n                :margin cider-repl-image-margin))\n\n(defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol)\n  \"A handler for inserting a jpeg IMAGE into a repl BUFFER.\nPart of the default `cider-repl-content-type-handler-alist'.\"\n  (cider-repl--display-image buffer\n                             (cider-repl--image image 'jpeg t)\n                             show-prefix bol))\n\n(defun cider-repl-handle-png (_type buffer image &optional show-prefix bol)\n  \"A handler for inserting a png IMAGE into a repl BUFFER.\nPart of the default `cider-repl-content-type-handler-alist'.\"\n  (cider-repl--display-image buffer\n                             (cider-repl--image image 'png t)\n                             show-prefix bol))\n\n(defun cider-repl-handle-svg (_type buffer image &optional show-prefix bol)\n  \"A handler for inserting an svg IMAGE into a repl BUFFER.\nPart of the default `cider-repl-content-type-handler-alist'.\"\n  (cider-repl--display-image buffer\n                             (cider-repl--image image 'svg t)\n                             show-prefix bol))\n\n(defun cider-repl-handle-external-body (type buffer _ &optional _show-prefix _bol)\n  \"Handler for slurping external content into BUFFER.\nHandles an external-body TYPE by issuing a slurp request to fetch the content.\"\n  (if-let* ((args        (cadr type))\n            (access-type (nrepl-dict-get args \"access-type\")))\n      (nrepl-send-request\n       (list \"op\" \"slurp\" \"url\" (nrepl-dict-get args access-type))\n       (cider-repl-handler buffer)\n       (cider-current-repl)))\n  nil)\n\n(defvar cider-repl-content-type-handler-alist\n  `((\"message/external-body\" . ,#'cider-repl-handle-external-body)\n    (\"image/jpeg\" . ,#'cider-repl-handle-jpeg)\n    (\"image/png\" . ,#'cider-repl-handle-png)\n    (\"image/svg+xml\" . ,#'cider-repl-handle-svg))\n  \"Association list from content-types to handlers.\nHandlers must be functions of two required and two optional arguments - the\nREPL buffer to insert into, the value of the given content type as a raw\nstring, the REPL's show prefix as any and an `end-of-line' flag.\n\nThe return value of the handler should be a flag, indicating whether or not\nthe REPL is ready for a prompt to be displayed.  Most handlers should return\nt, as the content-type response is (currently) an alternative to the\nvalue response.  However for handlers which themselves issue subsequent\nnREPL ops, it may be convenient to prevent inserting a prompt.\")\n\n(defun cider-repl-handler (buffer)\n  \"Make an nREPL evaluation handler for the REPL BUFFER.\"\n  (let ((show-prompt t))\n    (nrepl-make-response-handler\n     buffer\n     (lambda (buffer value)\n       (cider-repl-emit-result buffer value t))\n     (lambda (buffer out)\n       (cider-repl-emit-stdout buffer out))\n     (lambda (buffer err)\n       (cider-repl-emit-stderr buffer err))\n     (lambda (buffer)\n       (when show-prompt\n         (cider-repl-emit-prompt buffer))\n       (when cider-repl-buffer-size-limit\n         (cider-repl-maybe-trim-buffer buffer)))\n     nrepl-err-handler\n     (lambda (buffer value content-type)\n       (if-let* ((content-attrs (cadr content-type))\n                 (content-type* (car content-type))\n                 (handler (cdr (assoc content-type*\n                                      cider-repl-content-type-handler-alist))))\n           (setq show-prompt (funcall handler content-type buffer value nil t))\n         (cider-repl-emit-result buffer value t t)))\n     (lambda (buffer warning)\n       (cider-repl-emit-stderr buffer warning)))))\n\n(defun cider--repl-request-map (right-margin)\n  \"Map to be merged into REPL eval requests.\nRIGHT-MARGIN is as in `cider--nrepl-print-request-map'.\"\n  (map-merge 'hash-table\n             (cider--nrepl-print-request-map right-margin)\n             (unless cider-repl-use-pretty-printing\n               '((\"nrepl.middleware.print/print\" \"cider.nrepl.pprint/pr\")))\n             (when cider-repl-use-content-types\n               (cider--nrepl-content-type-map))))\n\n(defun cider-repl--send-input (&optional newline)\n  \"Go to the end of the input and send the current input.\nIf NEWLINE is true then add a newline at the end of the input.\"\n  (unless (cider-repl--in-input-area-p)\n    (error \"No input at point\"))\n  (let ((input (cider-repl--current-input)))\n    (if (string-blank-p input)\n        ;; don't evaluate a blank string, but erase it and emit\n        ;; a fresh prompt to acknowledge to the user.\n        (progn\n          (cider-repl--replace-input \"\")\n          (cider-repl-emit-prompt (current-buffer)))\n      ;; otherwise evaluate the input\n      (goto-char (point-max))\n      (let ((end (point)))              ; end of input, without the newline\n        (cider-repl--add-to-input-history input)\n        (when newline\n          (insert \"\\n\"))\n        (let ((inhibit-modification-hooks t))\n          (add-text-properties cider-repl-input-start-mark\n                               (point)\n                               `(cider-old-input\n                                 ,(cl-incf cider-repl-old-input-counter))))\n        (unless cider-repl-use-clojure-font-lock\n          (let ((overlay (make-overlay cider-repl-input-start-mark end)))\n            ;; These properties are on an overlay so that they won't be taken\n            ;; by kill/yank.\n            (overlay-put overlay 'read-only t)\n            (overlay-put overlay 'font-lock-face 'cider-repl-input-face))))\n      (let ((input-start (save-excursion (cider-repl-beginning-of-defun) (point))))\n        (goto-char (point-max))\n        (cider-repl--mark-input-start)\n        (cider-repl--mark-output-start)\n        (cider-nrepl-request:eval\n         input\n         (cider-repl-handler (current-buffer))\n         (cider-current-ns)\n         (line-number-at-pos input-start)\n         (cider-column-number-at-pos input-start)\n         (thread-last\n           (cider--repl-request-map fill-column)\n           (map-pairs)\n           (seq-mapcat #'identity)))))))\n\n(defun cider-repl-return (&optional end-of-input)\n  \"Evaluate the current input string, or insert a newline.\nSend the current input only if a whole expression has been entered,\ni.e. the parenthesis are matched.\nWhen END-OF-INPUT is non-nil, send the input even if the parentheses\nare not balanced.\"\n  (interactive \"P\")\n  (cond\n   (end-of-input\n    (cider-repl--send-input))\n   ((and (get-text-property (point) 'cider-old-input)\n         (< (point) cider-repl-input-start-mark))\n    (cider-repl--grab-old-input end-of-input))\n   ((cider-repl--input-complete-p cider-repl-input-start-mark (point-max))\n    (cider-repl--send-input t))\n   (t\n    (cider-repl-newline-and-indent)\n    (message \"[input not complete]\"))))\n\n(defun cider-repl--grab-old-input (replace)\n  \"Resend the old REPL input at point.\nIf REPLACE is non-nil the current input is replaced with the old\ninput; otherwise the new input is appended.  The old input has the\ntext property `cider-old-input'.\"\n  (cl-multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input)\n    (let ((old-input (buffer-substring beg end)) ;;preserve\n          ;;properties, they will be removed later\n          (offset (- (point) beg)))\n      ;; Append the old input or replace the current input\n      (cond (replace (goto-char cider-repl-input-start-mark))\n            (t (goto-char (point-max))\n               (unless (eq (char-before) ?\\ )\n                 (insert \" \"))))\n      (delete-region (point) (point-max))\n      (save-excursion\n        (insert old-input)\n        (when (equal (char-before) ?\\n)\n          (delete-char -1)))\n      (forward-char offset))))\n\n(defun cider-repl-closing-return ()\n  \"Evaluate the current input string after closing input.\nCloses all open parentheses or bracketed expressions.\"\n  (interactive)\n  (goto-char (point-max))\n  (save-restriction\n    (narrow-to-region cider-repl-input-start-mark (point))\n    (let ((matching-delimiter nil))\n      (while (ignore-errors\n               (save-excursion\n                 (backward-up-list 1)\n                 (setq matching-delimiter (cdr (syntax-after (point)))))\n               t)\n        (insert-char matching-delimiter))))\n  (cider-repl-return))\n\n(defun cider-repl-toggle-pretty-printing ()\n  \"Toggle pretty-printing in the REPL.\"\n  (interactive)\n  (setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing))\n  (message \"Pretty printing in REPL %s.\"\n           (if cider-repl-use-pretty-printing \"enabled\" \"disabled\")))\n\n(defun cider-repl-toggle-content-types ()\n  \"Toggle content-type rendering in the REPL.\"\n  (interactive)\n  (setq cider-repl-use-content-types (not cider-repl-use-content-types))\n  (message \"Content-type support in REPL %s.\"\n           (if cider-repl-use-content-types \"enabled\" \"disabled\")))\n\n(defun cider-repl-toggle-clojure-font-lock ()\n  \"Toggle pretty-printing in the REPL.\"\n  (interactive)\n  (setq cider-repl-use-clojure-font-lock (not cider-repl-use-clojure-font-lock))\n  (message \"Clojure font-locking in REPL %s.\"\n           (if cider-repl-use-clojure-font-lock \"enabled\" \"disabled\")))\n\n(defun cider-repl-switch-to-other ()\n  \"Switch between the Clojure and ClojureScript REPLs for the current project.\"\n  (interactive)\n  ;; FIXME: implement cycling as session can hold more than two REPLs\n  (let* ((this-repl (cider-current-repl nil 'ensure))\n         (other-repl (car (seq-remove (lambda (r) (eq r this-repl)) (cider-repls nil t)))))\n    (if other-repl\n        (switch-to-buffer other-repl)\n      (user-error \"No other REPL in current session (%s)\"\n                  (car (sesman-current-session 'CIDER))))))\n\n(defvar cider-repl-clear-buffer-hook)\n\n(defun cider-repl--clear-region (start end)\n  \"Delete the output and its overlays between START and END.\"\n  (mapc #'delete-overlay (overlays-in start end))\n  (delete-region start end))\n\n(defun cider-repl-clear-buffer ()\n  \"Clear the currently visited REPL buffer completely.\nSee also the related commands `cider-repl-clear-output' and\n`cider-find-and-clear-repl-output'.\"\n  (interactive)\n  (let ((inhibit-read-only t))\n    (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark)\n    (cider-repl--clear-region cider-repl-output-start cider-repl-output-end)\n    (when (< (point) cider-repl-input-start-mark)\n      (goto-char cider-repl-input-start-mark))\n    (recenter t))\n  (run-hooks 'cider-repl-clear-buffer-hook))\n\n(defun cider-repl-clear-output (&optional clear-repl)\n  \"Delete the output inserted since the last input.\nWith a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead.\"\n  (interactive \"P\")\n  (if clear-repl\n      (cider-repl-clear-buffer)\n    (let ((inhibit-read-only t))\n      (cider-repl--clear-region cider-repl-output-start cider-repl-output-end)\n      (save-excursion\n        (goto-char cider-repl-output-end)\n        (insert-before-markers\n         (propertize \";; output cleared\\n\" 'font-lock-face 'font-lock-comment-face))))))\n\n(defun cider-repl-clear-banners ()\n  \"Delete the REPL banners.\"\n  (interactive)\n  ;; TODO: Improve the boundaries detecting logic\n  ;; probably it should be based on text properties\n  ;; the current implementation will clear warnings as well\n  (let ((start (point-min))\n        (end (save-excursion\n               (goto-char (point-min))\n               (cider-repl-next-prompt)\n               (forward-line -1)\n               (end-of-line)\n               (point))))\n    (when (< start end)\n      (let ((inhibit-read-only t))\n        (cider-repl--clear-region start (1+ end))))))\n\n(defun cider-repl-clear-help-banner ()\n  \"Delete the help REPL banner.\"\n  (interactive)\n  ;; TODO: Improve the boundaries detecting logic\n  ;; probably it should be based on text properties\n  (let ((start (save-excursion\n                 (goto-char (point-min))\n                 (search-forward \";; =\")\n                 (beginning-of-line)\n                 (point)))\n        (end (save-excursion\n               (goto-char (point-min))\n               (cider-repl-next-prompt)\n               (search-backward \";; =\")\n               (end-of-line)\n               (point))))\n    (when (< start end)\n      (let ((inhibit-read-only t))\n        (cider-repl--clear-region start (1+ end))))))\n\n(defun cider-repl-switch-ns-handler (buffer)\n  \"Make an nREPL evaluation handler for the REPL BUFFER's ns switching.\"\n  (nrepl-make-response-handler buffer\n                               (lambda (_buffer _value))\n                               (lambda (buffer out)\n                                 (cider-repl-emit-stdout buffer out))\n                               (lambda (buffer err)\n                                 (cider-repl-emit-stderr buffer err))\n                               (lambda (buffer)\n                                 (cider-repl-emit-prompt buffer))))\n\n(defun cider-repl-set-ns (ns)\n  \"Switch the namespace of the REPL buffer to NS.\nIf called from a cljc buffer act on both the Clojure and ClojureScript REPL\nif there are more than one REPL present.  If invoked in a REPL buffer the\ncommand will prompt for the name of the namespace to switch to.\"\n  (interactive (list (if (or (derived-mode-p 'cider-repl-mode)\n                             (null (cider-ns-form)))\n                         (completing-read \"Switch to namespace: \"\n                                          (cider-sync-request:ns-list))\n                       (cider-current-ns))))\n  (when (or (not ns) (equal ns \"\"))\n    (user-error \"No namespace selected\"))\n  (cider-map-repls :auto\n    (lambda (connection)\n      ;; NOTE: `require' and `in-ns' are special forms in ClojureScript.\n      ;; That's why we eval them separately instead of combining them with `do'.\n      (when cider-repl-require-ns-on-set\n        (cider-sync-tooling-eval (format \"(require '%s)\" ns) nil connection))\n      (cider-tooling-eval (format \"(in-ns '%s)\" ns)\n                          (cider-repl-switch-ns-handler connection)))))\n\n\f\n;;; Location References\n\n(defcustom cider-locref-regexp-alist\n  '((stdout-stacktrace \"[ \\t]\\\\(at \\\\([^$(]+\\\\).*(\\\\([^:()]+\\\\):\\\\([0-9]+\\\\))\\\\)\" 1 2 3 4)\n    (aviso-stacktrace  \"^[ \\t]*\\\\(\\\\([^$/ \\t]+\\\\).*? +\\\\([^:]+\\\\): +\\\\([0-9]+\\\\)\\\\)\" 1 2 3 4)\n    (print-stacktrace  \"\\\\[\\\\([^][$ \\t]+\\\\).* +\\\\([^ \\t]+\\\\) +\\\\([0-9]+\\\\)\\\\]\" 0 1 2 3)\n    (timbre-log        \"\\\\(TRACE\\\\|INFO\\\\|DEBUG\\\\|WARN\\\\|ERROR\\\\) +\\\\(\\\\[\\\\([^:]+\\\\):\\\\([0-9]+\\\\)\\\\]\\\\)\" 2 3 nil 4)\n    (cljs-message      \"at line \\\\([0-9]+\\\\) +\\\\(.*\\\\)$\" 0 nil 2 1)\n    (warning           \"warning,? +\\\\(\\\\([^\\n:]+\\\\):\\\\([0-9]+\\\\):[0-9]+\\\\)\" 1 nil 2 3)\n    (compilation       \".*compiling:(\\\\([^\\n:)]+\\\\):\\\\([0-9]+\\\\):[0-9]+)\" 0 nil 1 2))\n  \"Alist holding regular expressions for inline location references.\nEach element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE\nLINE), where NAME is the identifier of the regexp, REGEXP - regexp matching\na location, HIGHLIGHT - sub-expression matching region to highlight on\nmouse-over, VAR - sub-expression giving Clojure VAR to look up.  FILE is\ncurrently only used when VAR is nil and must be full resource path in that\ncase.\"\n  :type '(alist :key-type sexp)\n  :package-version '(cider. \"0.16.0\"))\n\n(defun cider--locref-at-point-1 (reg-list)\n  \"Workhorse for getting locref at point.\nREG-LIST is an entry in `cider-locref-regexp-alist'.\"\n  (beginning-of-line)\n  (when (re-search-forward (nth 1 reg-list) (point-at-eol) t)\n    (let ((ix-highlight (or (nth 2 reg-list) 0))\n          (ix-var (nth 3 reg-list))\n          (ix-file (nth 4 reg-list))\n          (ix-line (nth 5 reg-list)))\n      (list\n       :type (car reg-list)\n       :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight))\n       :var  (and ix-var\n                  (replace-regexp-in-string \"_\" \"-\"\n                                            (match-string-no-properties ix-var)\n                                            nil t))\n       :file (and ix-file (match-string-no-properties ix-file))\n       :line (and ix-line (string-to-number (match-string-no-properties ix-line)))))))\n\n(defun cider-locref-at-point (&optional pos)\n  \"Return a plist of components of the location reference at POS.\nLimit search to current line only and return nil if no location has been\nfound.  Returned keys are :type, :highlight, :var, :file, :line, where\n:highlight is a cons of positions, :var and :file are strings or nil, :line\nis a number.  See `cider-locref-regexp-alist' for how to specify regexes\nfor locref look up.\"\n  (save-excursion\n    (goto-char (or pos (point)))\n    ;; Regexp lookup on long lines can result in significant hangs #2532. We\n    ;; assume that lines longer than 300 don't contain source references.\n    (when (< (- (point-at-eol) (point-at-bol)) 300)\n      (seq-some (lambda (rl) (cider--locref-at-point-1 rl))\n                cider-locref-regexp-alist))))\n\n(defun cider-jump-to-locref-at-point (&optional pos)\n  \"Identify location reference at POS and navigate to it.\nThis function is used from help-echo property inside REPL buffers and uses\nregexes from `cider-locref-regexp-alist' to infer locations at point.\"\n  (interactive)\n  (if-let* ((loc (cider-locref-at-point pos)))\n      (let* ((var (plist-get loc :var))\n             (line (plist-get loc :line))\n             (file (or\n                    ;; 1) retrieve from info middleware\n                    (when var\n                      (or (cider-sync-request:ns-path var)\n                          (nrepl-dict-get (cider-sync-request:info var) \"file\")))\n                    (when-let* ((file (plist-get loc :file)))\n                      ;; 2) file detected by the regexp\n                      (or\n                       (if (file-name-absolute-p file)\n                           file\n                         ;; when not absolute, expand within the current project\n                         (when-let* ((proj (clojure-project-dir)))\n                           (let ((path (expand-file-name file proj)))\n                             (when (file-exists-p path)\n                               path))))\n                       ;; 3) infer ns from the abbreviated path (common in\n                       ;; reflection warnings)\n                       (let ((ns (cider-path-to-ns file)))\n                         (cider-sync-request:ns-path ns)))))))\n        (if file\n            (cider--jump-to-loc-from-info (nrepl-dict \"file\" file \"line\" line) t)\n          (error \"No source location for %s\" var)))\n    (user-error \"No location reference at point\")))\n\n(defvar cider-locref-hoover-overlay\n  (let ((o (make-overlay 1 1)))\n    (overlay-put o 'category 'cider-error-hoover)\n    ;; (overlay-put o 'face 'highlight)\n    (overlay-put o 'pointer 'hand)\n    (overlay-put o 'mouse-face 'highlight)\n    (overlay-put o 'follow-link 'mouse)\n    (overlay-put o 'keymap\n                 (let ((map (make-sparse-keymap)))\n                   (define-key map [return]  #'cider-jump-to-locref-at-point)\n                   (define-key map [mouse-2] #'cider-jump-to-locref-at-point)\n                   map))\n    o)\n  \"Overlay used during hoovering on location references in REPL buffers.\nOne for all REPLs.\")\n\n(defun cider-locref-help-echo (_win buffer pos)\n  \"Function for help-echo property in REPL buffers.\nWIN, BUFFER and POS are the window, buffer and point under mouse position.\"\n  (with-current-buffer buffer\n    (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight)))\n        (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl) buffer)\n      (delete-overlay cider-locref-hoover-overlay))\n    nil))\n\n\f\n;;; History\n\n(defcustom cider-repl-wrap-history nil\n  \"T to wrap history around when the end is reached.\"\n  :type 'boolean)\n\n;; These two vars contain the state of the last history search.  We\n;; only use them if `last-command' was `cider-repl--history-replace',\n;; otherwise we reinitialize them.\n\n(defvar cider-repl-input-history-position -1\n  \"Newer items have smaller indices.\")\n\n(defvar cider-repl-history-pattern nil\n  \"The regexp most recently used for finding input history.\")\n\n(defun cider-repl--add-to-input-history (string)\n  \"Add STRING to the input history.\nEmpty strings and duplicates are ignored.\"\n  (unless (or (equal string \"\")\n              (equal string (car cider-repl-input-history)))\n    (push string cider-repl-input-history)\n    (cl-incf cider-repl-input-history-items-added)))\n\n(defun cider-repl-delete-current-input ()\n  \"Delete all text after the prompt.\"\n  (goto-char (point-max))\n  (delete-region cider-repl-input-start-mark (point-max)))\n\n(defun cider-repl--replace-input (string)\n  \"Replace the current REPL input with STRING.\"\n  (cider-repl-delete-current-input)\n  (insert-and-inherit string))\n\n(defun cider-repl--position-in-history (start-pos direction regexp)\n  \"Return the position of the history item starting at START-POS.\nSearch in DIRECTION for REGEXP.\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 cider-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             if (string-match-p regexp (nth pos history)) return pos)))\n\n(defun cider-repl--history-replace (direction &optional regexp)\n  \"Replace the current input with the next line in DIRECTION.\nDIRECTION is 'forward' or 'backward' (in the history list).\nIf REGEXP is non-nil, only lines matching REGEXP are considered.\"\n  (setq cider-repl-history-pattern regexp)\n  (let* ((min-pos -1)\n         (max-pos (length cider-repl-input-history))\n         (pos0 (cond ((cider-history-search-in-progress-p)\n                      cider-repl-input-history-position)\n                     (t min-pos)))\n         (pos (cider-repl--position-in-history pos0 direction (or regexp \"\")))\n         (msg nil))\n    (cond ((and (< min-pos pos) (< pos max-pos))\n           (cider-repl--replace-input (nth pos cider-repl-input-history))\n           (setq msg (format \"History item: %d\" pos)))\n          ((not cider-repl-wrap-history)\n           (setq msg (cond ((= pos min-pos) \"End of history\")\n                           ((= pos max-pos) \"Beginning of history\"))))\n          (cider-repl-wrap-history\n           (setq pos (if (= pos min-pos) max-pos min-pos))\n           (setq msg \"Wrapped history\")))\n    (when (or (<= pos min-pos) (<= max-pos pos))\n      (when regexp\n        (setq msg (concat msg \"; no matching item\"))))\n    (message \"%s%s\" msg (cond ((not regexp) \"\")\n                              (t (format \"; current regexp: %s\" regexp))))\n    (setq cider-repl-input-history-position pos)\n    (setq this-command 'cider-repl--history-replace)))\n\n(defun cider-history-search-in-progress-p ()\n  \"Return t if a current history search is in progress.\"\n  (eq last-command 'cider-repl--history-replace))\n\n(defun cider-terminate-history-search ()\n  \"Terminate the current history search.\"\n  (setq last-command this-command))\n\n(defun cider-repl-previous-input ()\n  \"Cycle backwards through input history.\nIf the `last-command' was a history navigation command use the\nsame search pattern for this command.\nOtherwise use the current input as search pattern.\"\n  (interactive)\n  (cider-repl--history-replace 'backward (cider-repl-history-pattern t)))\n\n(defun cider-repl-next-input ()\n  \"Cycle forwards through input history.\nSee `cider-previous-input'.\"\n  (interactive)\n  (cider-repl--history-replace 'forward (cider-repl-history-pattern t)))\n\n(defun cider-repl-forward-input ()\n  \"Cycle forwards through input history.\"\n  (interactive)\n  (cider-repl--history-replace 'forward (cider-repl-history-pattern)))\n\n(defun cider-repl-backward-input ()\n  \"Cycle backwards through input history.\"\n  (interactive)\n  (cider-repl--history-replace 'backward (cider-repl-history-pattern)))\n\n(defun cider-repl-previous-matching-input (regexp)\n  \"Find the previous input matching REGEXP.\"\n  (interactive \"sPrevious element matching (regexp): \")\n  (cider-terminate-history-search)\n  (cider-repl--history-replace 'backward regexp))\n\n(defun cider-repl-next-matching-input (regexp)\n  \"Find then next input matching REGEXP.\"\n  (interactive \"sNext element matching (regexp): \")\n  (cider-terminate-history-search)\n  (cider-repl--history-replace 'forward regexp))\n\n(defun cider-repl-history-pattern (&optional use-current-input)\n  \"Return the regexp for the navigation commands.\nIf USE-CURRENT-INPUT is non-nil, use the current input.\"\n  (cond ((cider-history-search-in-progress-p)\n         cider-repl-history-pattern)\n        (use-current-input\n         (cl-assert (<= cider-repl-input-start-mark (point)))\n         (let ((str (cider-repl--current-input t)))\n           (cond ((string-match-p \"^[ \\n]*$\" str) nil)\n                 (t (concat \"^\" (regexp-quote str))))))\n        (t nil)))\n\n;;; persistent history\n(defcustom cider-repl-history-size 500\n  \"The maximum number of items to keep in the REPL history.\"\n  :type 'integer\n  :safe #'integerp)\n\n(defcustom cider-repl-history-file nil\n  \"File to save the persistent REPL history to.\"\n  :type 'string\n  :safe #'stringp)\n\n(defun cider-repl--history-read-filename ()\n  \"Ask the user which file to use, defaulting `cider-repl-history-file'.\"\n  (read-file-name \"Use CIDER REPL history file: \"\n                  cider-repl-history-file))\n\n(defun cider-repl--history-read (filename)\n  \"Read history from FILENAME and return it.\nIt does not yet set the input history.\"\n  (if (file-readable-p filename)\n      (with-temp-buffer\n        (insert-file-contents filename)\n        (when (> (buffer-size (current-buffer)) 0)\n          (read (current-buffer))))\n    '()))\n\n(defun cider-repl-history-load (&optional filename)\n  \"Load history from FILENAME into current session.\nFILENAME defaults to the value of `cider-repl-history-file' but user\ndefined filenames can be used to read special history files.\n\nThe value of `cider-repl-input-history' is set by this function.\"\n  (interactive (list (cider-repl--history-read-filename)))\n  (let ((f (or filename cider-repl-history-file)))\n    ;; TODO: probably need to set cider-repl-input-history-position as well.\n    ;; in a fresh connection the newest item in the list is currently\n    ;; not available.  After sending one input, everything seems to work.\n    (setq cider-repl-input-history (cider-repl--history-read f))))\n\n(defun cider-repl--history-write (filename)\n  \"Write history to FILENAME.\nCurrently coding system for writing the contents is hardwired to\nutf-8-unix.\"\n  (let* ((mhist (cider-repl--histories-merge cider-repl-input-history\n                                             cider-repl-input-history-items-added\n                                             (cider-repl--history-read filename)))\n         ;; newest items are at the beginning of the list, thus 0\n         (hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size))))\n    (unless (file-writable-p filename)\n      (error (format \"History file not writable: %s\" filename)))\n    (let ((print-length nil) (print-level nil))\n      (with-temp-file filename\n        ;; TODO: really set cs for output\n        ;; TODO: does cs need to be customizable?\n        (insert \";; -*- coding: utf-8-unix -*-\\n\")\n        (insert \";; Automatically written history of CIDER REPL session\\n\")\n        (insert \";; Edit at your own risk\\n\\n\")\n        (prin1 (mapcar #'substring-no-properties hist) (current-buffer))))))\n\n(defun cider-repl-history-save (&optional filename)\n  \"Save the current REPL input history to FILENAME.\nFILENAME defaults to the value of `cider-repl-history-file'.\"\n  (interactive (list (cider-repl--history-read-filename)))\n  (let* ((file (or filename cider-repl-history-file)))\n    (cider-repl--history-write file)))\n\n(defun cider-repl-history-just-save ()\n  \"Just save the history to `cider-repl-history-file'.\nThis function is meant to be used in hooks to avoid lambda\nconstructs.\"\n  (cider-repl-history-save cider-repl-history-file))\n\n;; SLIME has different semantics and will not save any duplicates.\n;; we keep track of how many items were added to the history in the\n;; current session in `cider-repl--add-to-input-history' and merge only the\n;; new items with the current history found in the file, which may\n;; have been changed in the meantime by another session.\n(defun cider-repl--histories-merge (session-hist n-added-items file-hist)\n  \"Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST.\"\n  (append (cl-subseq session-hist 0 n-added-items)\n          file-hist))\n\n\f\n;;; REPL shortcuts\n(defcustom cider-repl-shortcut-dispatch-char ?\\,\n  \"Character used to distinguish REPL commands from Lisp forms.\"\n  :type '(character))\n\n(defvar cider-repl-shortcuts (make-hash-table :test 'equal))\n\n(defun cider-repl-add-shortcut (name handler)\n  \"Add a REPL shortcut command, defined by NAME and HANDLER.\"\n  (puthash name handler cider-repl-shortcuts))\n\n(declare-function cider-toggle-trace-ns \"cider-tracing\")\n(declare-function cider-undef \"cider-eval\")\n(declare-function cider-browse-ns \"cider-browse-ns\")\n(declare-function cider-classpath \"cider-classpath\")\n(declare-function cider-repl-history \"cider-repl-history\")\n(declare-function cider-run \"cider-mode\")\n(declare-function cider-ns-refresh \"cider-ns\")\n(declare-function cider-ns-reload \"cider-ns\")\n(declare-function cider-find-var \"cider-find\")\n(declare-function cider-version \"cider\")\n(declare-function cider-test-run-loaded-tests \"cider-test\")\n(declare-function cider-test-run-project-tests \"cider-test\")\n(declare-function cider-sideloader-start \"cider-eval\")\n(cider-repl-add-shortcut \"clear-output\" #'cider-repl-clear-output)\n(cider-repl-add-shortcut \"clear\" #'cider-repl-clear-buffer)\n(cider-repl-add-shortcut \"clear-banners\" #'cider-repl-clear-banners)\n(cider-repl-add-shortcut \"clear-help-banner\" #'cider-repl-clear-help-banner)\n(cider-repl-add-shortcut \"trim\" #'cider-repl-trim-buffer)\n(cider-repl-add-shortcut \"ns\" #'cider-repl-set-ns)\n(cider-repl-add-shortcut \"toggle-pprint\" #'cider-repl-toggle-pretty-printing)\n(cider-repl-add-shortcut \"toggle-font-lock\" #'cider-repl-toggle-clojure-font-lock)\n(cider-repl-add-shortcut \"toggle-content-types\" #'cider-repl-toggle-content-types)\n(cider-repl-add-shortcut \"browse-ns\" (lambda () (interactive) (cider-browse-ns (cider-current-ns))))\n(cider-repl-add-shortcut \"classpath\" #'cider-classpath)\n(cider-repl-add-shortcut \"history\" #'cider-repl-history)\n(cider-repl-add-shortcut \"trace-ns\" #'cider-toggle-trace-ns)\n(cider-repl-add-shortcut \"sideloader-start\" #'cider-sideloader-start)\n(cider-repl-add-shortcut \"undef\" #'cider-undef)\n(cider-repl-add-shortcut \"refresh\" #'cider-ns-refresh)\n(cider-repl-add-shortcut \"reload\" #'cider-ns-reload)\n(cider-repl-add-shortcut \"find-var\" #'cider-find-var)\n(cider-repl-add-shortcut \"doc\" #'cider-doc)\n(cider-repl-add-shortcut \"help\" #'cider-repl-shortcuts-help)\n(cider-repl-add-shortcut \"test-ns\" #'cider-test-run-ns-tests)\n(cider-repl-add-shortcut \"test-all\" #'cider-test-run-loaded-tests)\n(cider-repl-add-shortcut \"test-project\" #'cider-test-run-project-tests)\n(cider-repl-add-shortcut \"test-ns-with-filters\" #'cider-test-run-ns-tests-with-filters)\n(cider-repl-add-shortcut \"test-all-with-filters\" (lambda () (interactive) (cider-test-run-loaded-tests 'prompt-for-filters)))\n(cider-repl-add-shortcut \"test-project-with-filters\" (lambda () (interactive) (cider-test-run-project-tests 'prompt-for-filters)))\n(cider-repl-add-shortcut \"test-report\" #'cider-test-show-report)\n(cider-repl-add-shortcut \"run\" #'cider-run)\n(cider-repl-add-shortcut \"conn-info\" #'cider-describe-connection)\n(cider-repl-add-shortcut \"version\" #'cider-version)\n(cider-repl-add-shortcut \"require-repl-utils\" #'cider-repl-require-repl-utils)\n;; So many ways to quit :-)\n(cider-repl-add-shortcut \"adios\" #'cider-quit)\n(cider-repl-add-shortcut \"sayonara\" #'cider-quit)\n(cider-repl-add-shortcut \"quit\" #'cider-quit)\n(cider-repl-add-shortcut \"restart\" #'cider-restart)\n\n(defconst cider-repl-shortcuts-help-buffer \"*CIDER REPL Shortcuts Help*\")\n\n(defun cider-repl-shortcuts-help ()\n  \"Display a help buffer.\"\n  (interactive)\n  (ignore-errors (kill-buffer cider-repl-shortcuts-help-buffer))\n  (with-current-buffer (get-buffer-create cider-repl-shortcuts-help-buffer)\n    (insert \"CIDER REPL shortcuts:\\n\\n\")\n    (maphash (lambda (k v) (insert (format \"%s:\\n\\t%s\\n\" k v))) cider-repl-shortcuts)\n    (goto-char (point-min))\n    (help-mode)\n    (display-buffer (current-buffer) t))\n  (cider-repl-handle-shortcut)\n  (current-buffer))\n\n(defun cider-repl--available-shortcuts ()\n  \"Return the available REPL shortcuts.\"\n  (cider-util--hash-keys cider-repl-shortcuts))\n\n(defun cider-repl-handle-shortcut ()\n  \"Execute a REPL shortcut.\"\n  (interactive)\n  (if (> (point) cider-repl-input-start-mark)\n      (insert (string cider-repl-shortcut-dispatch-char))\n    (let ((command (completing-read \"Command: \"\n                                    (cider-repl--available-shortcuts))))\n      (if (not (equal command \"\"))\n          (let ((command-func (gethash command cider-repl-shortcuts)))\n            (if command-func\n                (call-interactively command-func)\n              (error \"Unknown command %S.  Available commands: %s\"\n                     command-func\n                     (mapconcat #'identity (cider-repl--available-shortcuts) \", \"))))\n        (error \"No command selected\")))))\n\n\f\n;;;;; CIDER REPL mode\n(defvar cider-repl-mode-hook nil\n  \"Hook executed when entering `cider-repl-mode'.\")\n\n(defvar cider-repl-mode-syntax-table\n  (copy-syntax-table clojure-mode-syntax-table))\n\n(declare-function cider-eval-last-sexp \"cider-eval\")\n(declare-function cider-toggle-trace-ns \"cider-tracing\")\n(declare-function cider-toggle-trace-var \"cider-tracing\")\n(declare-function cider-find-resource \"cider-find\")\n(declare-function cider-find-ns \"cider-find\")\n(declare-function cider-find-keyword \"cider-find\")\n(declare-function cider-find-var \"cider-find\")\n(declare-function cider-switch-to-last-clojure-buffer \"cider-mode\")\n(declare-function cider-macroexpand-1 \"cider-macroexpansion\")\n(declare-function cider-macroexpand-all \"cider-macroexpansion\")\n(declare-function cider-selector \"cider-selector\")\n(declare-function cider-jack-in-clj \"cider\")\n(declare-function cider-jack-in-cljs \"cider\")\n(declare-function cider-connect-clj \"cider\")\n(declare-function cider-connect-cljs \"cider\")\n\n(defvar cider-repl-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"C-c C-d\") 'cider-doc-map)\n    (define-key map (kbd \"C-c ,\")   'cider-test-commands-map)\n    (define-key map (kbd \"C-c C-t\") 'cider-test-commands-map)\n    (define-key map (kbd \"M-.\") #'cider-find-var)\n    (define-key map (kbd \"C-c C-.\") #'cider-find-ns)\n    (define-key map (kbd \"C-c C-:\") #'cider-find-keyword)\n    (define-key map (kbd \"M-,\") #'cider-pop-back)\n    (define-key map (kbd \"C-c M-.\") #'cider-find-resource)\n    (define-key map (kbd \"RET\") #'cider-repl-return)\n    (define-key map (kbd \"TAB\") #'cider-repl-tab)\n    (define-key map (kbd \"C-\") #'cider-repl-closing-return)\n    (define-key map (kbd \"C-j\") #'cider-repl-newline-and-indent)\n    (define-key map (kbd \"C-c C-o\") #'cider-repl-clear-output)\n    (define-key map (kbd \"C-c M-n\") #'cider-repl-set-ns)\n    (define-key map (kbd \"C-c C-u\") #'cider-repl-kill-input)\n    (define-key map (kbd \"C-S-a\") #'cider-repl-bol-mark)\n    (define-key map [S-home] #'cider-repl-bol-mark)\n    (define-key map (kbd \"C-\") #'cider-repl-backward-input)\n    (define-key map (kbd \"C-\") #'cider-repl-forward-input)\n    (define-key map (kbd \"M-p\") #'cider-repl-previous-input)\n    (define-key map (kbd \"M-n\") #'cider-repl-next-input)\n    (define-key map (kbd \"M-r\") #'cider-repl-previous-matching-input)\n    (define-key map (kbd \"M-s\") #'cider-repl-next-matching-input)\n    (define-key map (kbd \"C-c C-n\") #'cider-repl-next-prompt)\n    (define-key map (kbd \"C-c C-p\") #'cider-repl-previous-prompt)\n    (define-key map (kbd \"C-c C-b\") #'cider-interrupt)\n    (define-key map (kbd \"C-c C-c\") #'cider-interrupt)\n    (define-key map (kbd \"C-c C-m\") #'cider-macroexpand-1)\n    (define-key map (kbd \"C-c M-m\") #'cider-macroexpand-all)\n    (define-key map (kbd \"C-c C-s\") #'sesman-map)\n    (define-key map (kbd \"C-c C-z\") #'cider-switch-to-last-clojure-buffer)\n    (define-key map (kbd \"C-c M-o\") #'cider-repl-switch-to-other)\n    (define-key map (kbd \"C-c M-s\") #'cider-selector)\n    (define-key map (kbd \"C-c M-d\") #'cider-describe-connection)\n    (define-key map (kbd \"C-c C-q\") #'cider-quit)\n    (define-key map (kbd \"C-c M-r\") #'cider-restart)\n    (define-key map (kbd \"C-c M-i\") #'cider-inspect)\n    (define-key map (kbd \"C-c M-p\") #'cider-repl-history)\n    (define-key map (kbd \"C-c M-t v\") #'cider-toggle-trace-var)\n    (define-key map (kbd \"C-c M-t n\") #'cider-toggle-trace-ns)\n    (define-key map (kbd \"C-c C-x\") 'cider-start-map)\n    (define-key map (kbd \"C-x C-e\") #'cider-eval-last-sexp)\n    (define-key map (kbd \"C-c C-r\") 'clojure-refactor-map)\n    (define-key map (kbd \"C-c C-v\") 'cider-eval-commands-map)\n    (define-key map (kbd \"C-c M-j\") #'cider-jack-in-clj)\n    (define-key map (kbd \"C-c M-J\") #'cider-jack-in-cljs)\n    (define-key map (kbd \"C-c M-c\") #'cider-connect-clj)\n    (define-key map (kbd \"C-c M-C\") #'cider-connect-cljs)\n\n    (define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut)\n    (easy-menu-define cider-repl-mode-menu map\n      \"Menu for CIDER's REPL mode\"\n      `(\"REPL\"\n        [\"Complete symbol\" complete-symbol]\n        \"--\"\n        ,cider-doc-menu\n        \"--\"\n        (\"Find\"\n         [\"Find definition\" cider-find-var]\n         [\"Find namespace\" cider-find-ns]\n         [\"Find resource\" cider-find-resource]\n         [\"Find keyword\" cider-find-keyword]\n         [\"Go back\" cider-pop-back])\n        \"--\"\n        [\"Switch to Clojure buffer\" cider-switch-to-last-clojure-buffer]\n        [\"Switch to other REPL\" cider-repl-switch-to-other]\n        \"--\"\n        (\"Macroexpand\"\n         [\"Macroexpand-1\" cider-macroexpand-1]\n         [\"Macroexpand-all\" cider-macroexpand-all])\n        \"--\"\n        ,cider-test-menu\n        \"--\"\n        [\"Run project (-main function)\" cider-run]\n        [\"Inspect\" cider-inspect]\n        [\"Toggle var tracing\" cider-toggle-trace-var]\n        [\"Toggle ns tracing\" cider-toggle-trace-ns]\n        [\"Refresh loaded code\" cider-ns-refresh]\n        \"--\"\n        [\"Set REPL ns\" cider-repl-set-ns]\n        [\"Toggle pretty printing\" cider-repl-toggle-pretty-printing]\n        [\"Toggle Clojure font-lock\" cider-repl-toggle-clojure-font-lock]\n        [\"Toggle rich content types\" cider-repl-toggle-content-types]\n        [\"Require REPL utils\" cider-repl-require-repl-utils]\n        \"--\"\n        [\"Browse classpath\" cider-classpath]\n        [\"Browse classpath entry\" cider-open-classpath-entry]\n        [\"Browse namespace\" cider-browse-ns]\n        [\"Browse all namespaces\" cider-browse-ns-all]\n        [\"Browse spec\" cider-browse-spec]\n        [\"Browse all specs\" cider-browse-spec-all]\n        \"--\"\n        [\"Next prompt\" cider-repl-next-prompt]\n        [\"Previous prompt\" cider-repl-previous-prompt]\n        [\"Clear output\" cider-repl-clear-output]\n        [\"Clear buffer\" cider-repl-clear-buffer]\n        [\"Trim buffer\" cider-repl-trim-buffer]\n        [\"Clear banners\" cider-repl-clear-banners]\n        [\"Clear help banner\" cider-repl-clear-help-banner]\n        [\"Kill input\" cider-repl-kill-input]\n        \"--\"\n        [\"Interrupt evaluation\" cider-interrupt]\n        \"--\"\n        [\"Connection info\" cider-describe-connection]\n        \"--\"\n        [\"Close ancillary buffers\" cider-close-ancillary-buffers]\n        [\"Quit\" cider-quit]\n        [\"Restart\" cider-restart]\n        \"--\"\n        [\"Clojure Cheatsheet\" cider-cheatsheet]\n        \"--\"\n        [\"A sip of CIDER\" cider-drink-a-sip]\n        [\"View user manual\" cider-view-manual]\n        [\"View quick reference card\" cider-view-refcard]\n        [\"Report a bug\" cider-report-bug]\n        [\"Version info\" cider-version]))\n    map))\n\n(sesman-install-menu cider-repl-mode-map)\n\n(defun cider-repl-wrap-fontify-function (func)\n  \"Return a function that will call FUNC narrowed to input region.\"\n  (lambda (beg end &rest rest)\n    (when (and cider-repl-input-start-mark\n               (> end cider-repl-input-start-mark))\n      (save-restriction\n        (narrow-to-region cider-repl-input-start-mark (point-max))\n        (let ((font-lock-dont-widen t))\n          (apply func (max beg cider-repl-input-start-mark) end rest))))))\n\n(declare-function cider-complete-at-point \"cider-completion\")\n(defvar cider--static-font-lock-keywords)\n\n(define-derived-mode cider-repl-mode fundamental-mode \"REPL\"\n  \"Major mode for Clojure REPL interactions.\n\n\\\\{cider-repl-mode-map}\"\n  (clojure-mode-variables)\n  (clojure-font-lock-setup)\n  (font-lock-add-keywords nil cider--static-font-lock-keywords)\n  (setq-local sesman-system 'CIDER)\n  (setq-local font-lock-fontify-region-function\n              (cider-repl-wrap-fontify-function font-lock-fontify-region-function))\n  (setq-local font-lock-unfontify-region-function\n              (cider-repl-wrap-fontify-function font-lock-unfontify-region-function))\n  (set-syntax-table cider-repl-mode-syntax-table)\n  (cider-eldoc-setup)\n  ;; At the REPL, we define beginning-of-defun and end-of-defun to be\n  ;; the start of the previous prompt or next prompt respectively.\n  ;; Notice the interplay with `cider-repl-beginning-of-defun'.\n  (setq-local beginning-of-defun-function #'cider-repl-mode-beginning-of-defun)\n  (setq-local end-of-defun-function #'cider-repl-mode-end-of-defun)\n  (setq-local prettify-symbols-alist clojure--prettify-symbols-alist)\n  ;; apply dir-local variables to REPL buffers\n  (hack-dir-local-variables-non-file-buffer)\n  (when cider-repl-history-file\n    (cider-repl-history-load cider-repl-history-file)\n    (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t)\n    (add-hook 'kill-emacs-hook #'cider-repl-history-just-save))\n  (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t)\n  (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map))))\n\n(provide 'cider-repl)\n\n;;; cider-repl.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-resolve.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52993607,"end":52993647},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52993647},"to":{"change":3,"start":52987634,"end":52987634},"introduced_by":3}],"inode":{"change":3,"pos":52987634}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52987634},"to":{"change":3,"start":52987635,"end":52993606},"introduced_by":3}],"inode":{"change":3,"pos":52987634}},"content":[{"Del":";;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection  -*- lexical-binding: t; -*-\n\n;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n\n;; Author: Artur Malabarba \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;; The ns cache is a dict of namespaces stored in the connection buffer.  This\n;; file offers functions to easily get information about variables from this\n;; cache, given the variable's name and the file's namespace.  This\n;; functionality is similar to that offered by the `cider-var-info' function\n;; (and others).  The difference is that all functions in this file operate\n;; without contacting the server (they still rely on an active connection\n;; buffer, but no messages are actually exchanged).\n\n;; For this reason, the functions here are well suited for very\n;; performance-sentitive operations, such as font-locking or\n;; indentation.  Meanwhile, operations like code-jumping are better off\n;; communicating with the middleware, just in the off chance that the cache is\n;; outdated.\n\n;; Below is a typical entry on this cache dict.  Note that clojure.core symbols\n;; are excluded from the refers to save space.\n\n;; \"cider.nrepl.middleware.track-state\"\n;; (dict \"aliases\"\n;;       (dict \"cljs\" \"cider.nrepl.middleware.util.cljs\"\n;;             \"misc\" \"cider.nrepl.middleware.util.misc\"\n;;             \"set\" \"clojure.set\")\n;;       \"interns\" (dict a\n;;                       \"assoc-state\"    (dict \"arglists\"\n;;                                              ((\"response\"\n;;                                                (dict \"as\" \"msg\" \"keys\"\n;;                                                      (\"session\")))))\n;;                       \"filter-core\"    (dict \"arglists\"\n;;                                              ((\"refers\")))\n;;                       \"make-transport\" (dict \"arglists\"\n;;                                              (((dict \"as\" \"msg\" \"keys\"\n;;                                                      (\"transport\")))))\n;;                       \"ns-as-map\"      (dict \"arglists\"\n;;                                              ((\"ns\")))\n;;                       \"ns-cache\"       (dict)\n;;                       \"relevant-meta\"  (dict \"arglists\"\n;;                                              ((\"var\")))\n;;                       \"update-vals\"    (dict \"arglists\"\n;;                                              ((\"m\" \"f\")))\n;;                       \"wrap-tracker\"   (dict \"arglists\"\n;;                                              ((\"handler\"))))\n;;       \"refers\" (dict \"set-descriptor!\" \"#'nrepl.middleware/set-descriptor!\"))\n\n;;; Code:\n\n(require 'cider-client)\n(require 'nrepl-dict)\n(require 'cider-util)\n\n(defvar cider-repl-ns-cache)\n\n(defun cider-resolve--get-in (&rest keys)\n  \"Return (nrepl-dict-get-in cider-repl-ns-cache KEYS).\"\n  (when-let* ((conn (cider-current-repl)))\n    (with-current-buffer conn\n      (nrepl-dict-get-in cider-repl-ns-cache keys))))\n\n(defun cider-resolve-alias (ns alias)\n  \"Return the namespace that ALIAS refers to in namespace NS.\nIf it doesn't point anywhere, returns ALIAS.\"\n  (or (cider-resolve--get-in ns \"aliases\" alias)\n      alias))\n\n(defconst cider-resolve--prefix-regexp \"\\\\`\\\\(?:#'\\\\)?\\\\([^/]+\\\\)/\")\n\n(defun cider-resolve-var (ns var)\n  \"Return a dict of the metadata of a clojure var VAR in namespace NS.\nVAR is a string.\nReturn nil only if VAR cannot be resolved.\"\n  (let* ((var-ns (when (string-match cider-resolve--prefix-regexp var)\n                   (cider-resolve-alias ns (match-string 1 var))))\n         (name (replace-regexp-in-string cider-resolve--prefix-regexp \"\" var)))\n    (or\n     (cider-resolve--get-in (or var-ns ns) \"interns\" name)\n     (unless var-ns\n       ;; If the var had no prefix, it might be referred.\n       (if-let* ((referral (cider-resolve--get-in ns \"refers\" name)))\n           (cider-resolve-var ns referral)\n         ;; Or it might be from core.\n         (unless (equal ns \"clojure.core\")\n           (cider-resolve-var \"clojure.core\" name)))))))\n\n(defun cider-resolve-core-ns ()\n  \"Return a dict of the core namespace for current connection.\nThis will be clojure.core or cljs.core depending on the return value of the\nfunction `cider-repl-type'.\"\n  (when-let* ((repl (cider-current-repl)))\n    (with-current-buffer repl\n      (cider-resolve--get-in (if (eq cider-repl-type 'cljs)\n                                 \"cljs.core\"\n                               \"clojure.core\")))))\n\n(defun cider-resolve-ns-symbols (ns)\n  \"Return a plist of all valid symbols in NS.\nEach entry's value is the metadata of the var that the symbol refers to.\nNS can be the namespace name, or a dict of the namespace itself.\"\n  (when-let* ((dict (if (stringp ns)\n                        (cider-resolve--get-in ns)\n                      ns)))\n    (nrepl-dbind-response dict (interns _refers aliases)\n      (append (cdr interns)\n              (nrepl-dict-flat-map (lambda (alias namespace)\n                                     (nrepl-dict-flat-map (lambda (sym meta)\n                                                            (list (concat alias \"/\" sym) meta))\n                                                          (cider-resolve--get-in namespace \"interns\")))\n                                   aliases)))))\n\n(provide 'cider-resolve)\n;;; cider-resolve.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-scratch.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52987592,"end":52987632},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52987632},"to":{"change":3,"start":52984057,"end":52984057},"introduced_by":3}],"inode":{"change":3,"pos":52984057}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52984057},"to":{"change":3,"start":52984058,"end":52987591},"introduced_by":3}],"inode":{"change":3,"pos":52984057}},"content":[{"Del":";;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Imitate Emacs's *scratch* buffer.\n\n;;; Code:\n\n(require 'cider-eval)\n(require 'clojure-mode)\n(require 'easymenu)\n\n(defcustom cider-scratch-initial-message\n  \";; This buffer is for Clojure experiments and evaluation.\\n\n;; Press C-j to evaluate the last expression.\\n\n;; You can also press C-u C-j to evaluate the expression and pretty-print its result.\\n\\n\"\n  \"The initial message displayed in new scratch buffers.\"\n  :type 'string\n  :group 'cider\n  :package-version '(cider . \"0.18.0\"))\n\n(defvar cider-clojure-interaction-mode-map\n  (let ((map (make-sparse-keymap)))\n    (set-keymap-parent map clojure-mode-map)\n    (define-key map (kbd \"C-j\") #'cider-eval-print-last-sexp)\n    (define-key map [remap paredit-newline] #'cider-eval-print-last-sexp)\n    (easy-menu-define cider-clojure-interaction-mode-menu map\n      \"Menu for Clojure Interaction mode\"\n      '(\"Clojure Interaction\"\n        ([\"Eval and print last sexp\" #'cider-eval-print-last-sexp]\n         \"--\"\n         [\"Reset\" #'cider-scratch-reset])))\n    map))\n\n(defconst cider-scratch-buffer-name \"*cider-scratch*\")\n\n;;;###autoload\n(defun cider-scratch ()\n  \"Go to the scratch buffer named `cider-scratch-buffer-name'.\"\n  (interactive)\n  (pop-to-buffer (cider-scratch-find-or-create-buffer)))\n\n(defun cider-scratch-find-or-create-buffer ()\n  \"Find or create the scratch buffer.\"\n  (or (get-buffer cider-scratch-buffer-name)\n      (cider-scratch--create-buffer)))\n\n(define-derived-mode cider-clojure-interaction-mode clojure-mode \"Clojure Interaction\"\n  \"Major mode for typing and evaluating Clojure forms.\nLike `clojure-mode' except that \\\\[cider-eval-print-last-sexp] evals the Lisp expression\nbefore point, and prints its value into the buffer, advancing point.\n\n\\\\{cider-clojure-interaction-mode-map}\"\n  (setq-local sesman-system 'CIDER))\n\n(defun cider-scratch--insert-welcome-message ()\n  \"Insert the welcome message for the scratch buffer.\"\n  (insert cider-scratch-initial-message))\n\n(defun cider-scratch--create-buffer ()\n  \"Create a new scratch buffer.\"\n  (with-current-buffer (get-buffer-create cider-scratch-buffer-name)\n    (cider-clojure-interaction-mode)\n    (cider-scratch--insert-welcome-message)\n    (current-buffer)))\n\n(defun cider-scratch-reset ()\n  \"Reset the current scratch buffer.\"\n  (interactive)\n  (erase-buffer)\n  (cider-scratch--insert-welcome-message))\n\n(provide 'cider-scratch)\n\n;;; cider-scratch.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-selector.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52984014,"end":52984055},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52984055},"to":{"change":3,"start":52977274,"end":52977274},"introduced_by":3}],"inode":{"change":3,"pos":52977274}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52977274},"to":{"change":3,"start":52977275,"end":52984013},"introduced_by":3}],"inode":{"change":3,"pos":52977274}},"content":[{"Del":";;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Buffer selection command inspired by SLIME's selector.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-eval)\n(require 'cider-scratch)\n(require 'cider-profile)\n\n(defconst cider-selector-help-buffer \"*CIDER Selector Help*\"\n  \"The name of the selector's help buffer.\")\n\n(defvar cider-selector-methods nil\n  \"List of buffer-selection methods for the `cider-selector' command.\nEach element is a list (KEY DESCRIPTION FUNCTION).\nDESCRIPTION is a one-line description of what the key selects.\")\n\n(defvar cider-selector-other-window nil\n  \"If non-nil use `switch-to-buffer-other-window'.\nNot meant to be set by users.  It's used internally\nby `cider-selector'.\")\n\n(defun cider-selector--recently-visited-buffer (mode &optional consider-visible-p)\n  \"Return the most recently visited buffer, deriving its `major-mode' from MODE.\nCONSIDER-VISIBLE-P will allow handling of visible windows as well.\nFirst pass only considers buffers that are not already visible.\nSecond pass will attempt one of visible ones for scenarios where the window\nis visible, but not focused.\"\n  (cl-loop for buffer in (buffer-list)\n           when (and (with-current-buffer buffer\n                       (derived-mode-p mode))\n                     ;; names starting with space are considered hidden by Emacs\n                     (not (string-match-p \"^ \" (buffer-name buffer)))\n                     (or consider-visible-p\n                         (null (get-buffer-window buffer 'visible))))\n           return buffer\n           finally (if consider-visible-p\n                       (error \"Can't find unshown buffer in %S\" mode)\n                     (cider-selector--recently-visited-buffer mode t))))\n\n;;;###autoload\n(defun cider-selector (&optional other-window)\n  \"Select a new buffer by type, indicated by a single character.\nThe user is prompted for a single character indicating the method by\nwhich to choose a new buffer.  The `?' character describes the\navailable methods.  OTHER-WINDOW provides an optional target.\nSee `def-cider-selector-method' for defining new methods.\"\n  (interactive)\n  (message \"Select [%s]: \"\n           (apply #'string (mapcar #'car cider-selector-methods)))\n  (let* ((cider-selector-other-window other-window)\n         (ch (save-window-excursion\n               (select-window (minibuffer-window))\n               (read-char)))\n         (method (cl-find ch cider-selector-methods :key #'car)))\n    (cond (method\n           (funcall (cl-caddr method)))\n          (t\n           (message \"No method for character: ?\\\\%c\" ch)\n           (ding)\n           (sleep-for 1)\n           (discard-input)\n           (cider-selector)))))\n\n(defmacro def-cider-selector-method (key description &rest body)\n  \"Define a new `cider-select' buffer selection method.\nKEY is the key the user will enter to choose this method.\n\nDESCRIPTION is a one-line sentence describing how the method\nselects a buffer.\n\nBODY is a series of forms which are evaluated when the selector\nis chosen.  The returned buffer is selected with\n`switch-to-buffer'.\"\n  (let ((method `(lambda ()\n                   (let ((buffer (progn ,@body)))\n                     (cond ((not (and buffer (get-buffer buffer)))\n                            (message \"No such buffer: %S\" buffer)\n                            (ding))\n                           ((get-buffer-window buffer)\n                            (select-window (get-buffer-window buffer)))\n                           (cider-selector-other-window\n                            (switch-to-buffer-other-window buffer))\n                           (t\n                            (switch-to-buffer buffer)))))))\n    `(setq cider-selector-methods\n           (cl-sort (cons (list ,key ,description ,method)\n                          (cl-remove ,key cider-selector-methods :key #'car))\n                    #'< :key #'car))))\n\n(def-cider-selector-method ?? \"Selector help buffer.\"\n  (ignore-errors (kill-buffer cider-selector-help-buffer))\n  (with-current-buffer (get-buffer-create cider-selector-help-buffer)\n    (insert \"CIDER Selector Methods:\\n\\n\")\n    (cl-loop for (key line nil) in cider-selector-methods\n             do (insert (format \"%c:\\t%s\\n\" key line)))\n    (goto-char (point-min))\n    (help-mode)\n    (display-buffer (current-buffer) t))\n  (cider-selector)\n  (current-buffer))\n\n(cl-pushnew (list ?4 \"Select in other window\" (lambda () (cider-selector t)))\n            cider-selector-methods :key #'car)\n\n(def-cider-selector-method ?c\n  \"Most recently visited clojure-mode buffer.\"\n  (cider-selector--recently-visited-buffer 'clojure-mode))\n\n(def-cider-selector-method ?e\n  \"Most recently visited emacs-lisp-mode buffer.\"\n  (cider-selector--recently-visited-buffer 'emacs-lisp-mode))\n\n(def-cider-selector-method ?q \"Abort.\"\n  (top-level))\n\n(def-cider-selector-method ?r\n  \"Current REPL buffer or as a fallback, the most recently\nvisited cider-repl-mode buffer.\"\n  (or (cider-current-repl)\n      (cider-selector--recently-visited-buffer 'cider-repl-mode)))\n\n(def-cider-selector-method ?m\n  \"Current connection's *nrepl-messages* buffer.\"\n  (nrepl-messages-buffer (cider-current-repl)))\n\n(def-cider-selector-method ?x\n  \"*cider-error* buffer.\"\n  cider-error-buffer)\n\n(def-cider-selector-method ?p\n  \"*cider-profile* buffer.\"\n  cider-profile-buffer)\n\n(def-cider-selector-method ?d\n  \"*cider-doc* buffer.\"\n  cider-doc-buffer)\n\n(def-cider-selector-method ?s\n  \"*cider-scratch* buffer.\"\n  (cider-scratch-find-or-create-buffer))\n\n(provide 'cider-selector)\n\n;;; cider-selector.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-stacktrace.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52977229,"end":52977272},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52977272},"to":{"change":3,"start":52937788,"end":52937788},"introduced_by":3}],"inode":{"change":3,"pos":52937788}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52937788},"to":{"change":3,"start":52937789,"end":52977228},"introduced_by":3}],"inode":{"change":3,"pos":52937788}},"content":[{"Del":";;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors\n\n;; Author: Jeff Valk \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Stacktrace filtering and stack frame source navigation\n\n;;; Code:\n\n(require 'button)\n(require 'cl-lib)\n(require 'easymenu)\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'cider-common)\n(require 'cider-client)\n(require 'cider-popup)\n(require 'cider-util)\n\n;; Variables\n\n(defgroup cider-stacktrace nil\n  \"Stacktrace filtering and navigation.\"\n  :prefix \"cider-stacktrace-\"\n  :group 'cider)\n\n(defcustom cider-stacktrace-fill-column t\n  \"Fill column for error messages in stacktrace display.\nIf nil, messages will not be wrapped.  If truthy but non-numeric,\n`fill-column' will be used.\"\n  :type 'list\n  :package-version '(cider . \"0.7.0\"))\n\n(defcustom cider-stacktrace-default-filters '(tooling dup)\n  \"Frame types to omit from initial stacktrace display.\"\n  :type 'list\n  :package-version '(cider . \"0.6.0\"))\n\n(make-obsolete 'cider-stacktrace-print-length 'cider-stacktrace-print-options \"0.20\")\n(make-obsolete 'cider-stacktrace-print-level 'cider-stacktrace-print-options \"0.20\")\n(make-obsolete-variable 'cider-stacktrace-print-options 'cider-print-options \"0.21\")\n\n(defvar cider-stacktrace-detail-max 2\n  \"The maximum detail level for causes.\")\n\n(defvar-local cider-stacktrace-hidden-frame-count 0)\n(defvar-local cider-stacktrace-filters nil)\n(defvar-local cider-stacktrace-cause-visibility nil)\n(defvar-local cider-stacktrace-positive-filters nil)\n\n(defconst cider-error-buffer \"*cider-error*\")\n\n(make-obsolete 'cider-visit-error-buffer 'cider-selector \"0.18\")\n\n(defcustom cider-stacktrace-suppressed-errors '()\n  \"Errors that won't make the stacktrace buffer 'pop-over' your active window.\nThe error types are represented as strings.\"\n  :type 'list\n  :package-version '(cider . \"0.12.0\"))\n\n;; Faces\n\n(defface cider-stacktrace-error-class-face\n  '((t (:inherit font-lock-warning-face)))\n  \"Face for exception class names.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-error-message-face\n  '((t (:inherit font-lock-doc-face)))\n  \"Face for exception messages.\"\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-stacktrace-filter-active-face\n  '((t (:inherit button :underline t :weight normal)))\n  \"Face for filter buttons representing frames currently visible.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-filter-inactive-face\n  '((t (:inherit button :underline nil :weight normal)))\n  \"Face for filter buttons representing frames currently filtered out.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-face\n  '((t (:inherit default)))\n  \"Face for stack frame text.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-ns-face\n  '((t (:inherit font-lock-comment-face)))\n  \"Face for stack frame namespace name.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-fn-face\n  '((t (:inherit default :weight bold)))\n  \"Face for stack frame function name.\"\n  :package-version '(cider . \"0.6.0\"))\n\n(defface cider-stacktrace-promoted-button-face\n  '((((type graphic))\n     :box (:line-width 3 :style released-button)\n     :inherit error)\n    (t :inverse-video t))\n  \"A button with this face represents a promoted (non-suppressed) error type.\"\n  :package-version '(cider . \"0.12.0\"))\n\n(defface cider-stacktrace-suppressed-button-face\n  '((((type graphic))\n     :box (:line-width 3 :style pressed-button)\n     :inherit widget-inactive)\n    (t :inverse-video t))\n  \"A button with this face represents a suppressed error type.\"\n  :package-version '(cider . \"0.12.0\"))\n\n;; Colors & Theme Support\n\n(defvar cider-stacktrace-frames-background-color\n  (cider-scale-background-color)\n  \"Background color for stacktrace frames.\")\n\n(advice-add 'enable-theme  :after #'cider--stacktrace-adapt-to-theme)\n(advice-add 'disable-theme :after #'cider--stacktrace-adapt-to-theme)\n(defun cider--stacktrace-adapt-to-theme (&rest _)\n  \"When theme is changed, update `cider-stacktrace-frames-background-color'.\"\n  (setq cider-stacktrace-frames-background-color\n        (cider-scale-background-color)))\n\n\n;; Mode & key bindings\n\n(defvar cider-stacktrace-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"M-p\") #'cider-stacktrace-previous-cause)\n    (define-key map (kbd \"M-n\") #'cider-stacktrace-next-cause)\n    (define-key map (kbd \"M-.\") #'cider-stacktrace-jump)\n    (define-key map \"q\" #'cider-popup-buffer-quit-function)\n    (define-key map \"j\" #'cider-stacktrace-toggle-java)\n    (define-key map \"c\" #'cider-stacktrace-toggle-clj)\n    (define-key map \"r\" #'cider-stacktrace-toggle-repl)\n    (define-key map \"t\" #'cider-stacktrace-toggle-tooling)\n    (define-key map \"d\" #'cider-stacktrace-toggle-duplicates)\n    (define-key map \"p\" #'cider-stacktrace-show-only-project)\n    (define-key map \"a\" #'cider-stacktrace-toggle-all)\n    (define-key map \"1\" #'cider-stacktrace-cycle-cause-1)\n    (define-key map \"2\" #'cider-stacktrace-cycle-cause-2)\n    (define-key map \"3\" #'cider-stacktrace-cycle-cause-3)\n    (define-key map \"4\" #'cider-stacktrace-cycle-cause-4)\n    (define-key map \"5\" #'cider-stacktrace-cycle-cause-5)\n    (define-key map \"0\" #'cider-stacktrace-cycle-all-causes)\n    (define-key map (kbd \"TAB\") #'cider-stacktrace-cycle-current-cause)\n    (define-key map [backtab] #'cider-stacktrace-cycle-all-causes)\n    (easy-menu-define cider-stacktrace-mode-menu map\n      \"Menu for CIDER's stacktrace mode\"\n      '(\"Stacktrace\"\n        [\"Previous cause\" cider-stacktrace-previous-cause]\n        [\"Next cause\" cider-stacktrace-next-cause]\n        \"--\"\n        [\"Jump to frame source\" cider-stacktrace-jump]\n        \"--\"\n        [\"Cycle current cause detail\" cider-stacktrace-cycle-current-cause]\n        [\"Cycle cause #1 detail\" cider-stacktrace-cycle-cause-1]\n        [\"Cycle cause #2 detail\" cider-stacktrace-cycle-cause-2]\n        [\"Cycle cause #3 detail\" cider-stacktrace-cycle-cause-3]\n        [\"Cycle cause #4 detail\" cider-stacktrace-cycle-cause-4]\n        [\"Cycle cause #5 detail\" cider-stacktrace-cycle-cause-5]\n        [\"Cycle all cause detail\" cider-stacktrace-cycle-all-causes]\n        \"--\"\n        [\"Show/hide Java frames\" cider-stacktrace-toggle-java]\n        [\"Show/hide Clojure frames\" cider-stacktrace-toggle-clj]\n        [\"Show/hide REPL frames\" cider-stacktrace-toggle-repl]\n        [\"Show/hide tooling frames\" cider-stacktrace-toggle-tooling]\n        [\"Show/hide duplicate frames\" cider-stacktrace-toggle-duplicates]\n        [\"Toggle only project frames\" cider-stacktrace-show-only-project]\n        [\"Show/hide all frames\" cider-stacktrace-toggle-all]))\n    map))\n\n(define-derived-mode cider-stacktrace-mode special-mode \"Stacktrace\"\n  \"Major mode for filtering and navigating CIDER stacktraces.\n\n\\\\{cider-stacktrace-mode-map}\"\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t))\n  (setq-local sesman-system 'CIDER)\n  (setq-local electric-indent-chars nil)\n  (setq-local cider-stacktrace-hidden-frame-count 0)\n  (setq-local cider-stacktrace-filters cider-stacktrace-default-filters)\n  (setq-local cider-stacktrace-cause-visibility (make-vector 10 0))\n  (buffer-disable-undo))\n\n\n;; Stacktrace filtering\n\n(defvar cider-stacktrace--all-negative-filters\n  '(clj tooling dup java repl)\n  \"Filters that remove stackframes.\")\n\n(defvar cider-stacktrace--all-positive-filters\n  '(project all)\n  \"Filters that ensure stackframes are shown.\")\n\n(defun cider-stacktrace--face-for-filter (filter neg-filters pos-filters)\n  \"Return whether we should mark the FILTER is active or not.\n\nNEG-FILTERS and POS-FILTERS are lists of filters to check FILTER's type.\n\nNEG-FILTERS dictate which frames should be hidden while POS-FILTERS can\noverride this and ensure that those frames are shown.\"\n  (cond ((member filter cider-stacktrace--all-negative-filters)\n         (if (member filter neg-filters)\n             'cider-stacktrace-filter-active-face\n           'cider-stacktrace-filter-inactive-face))\n        ((member filter cider-stacktrace--all-positive-filters)\n         (if (member filter pos-filters)\n             'cider-stacktrace-filter-active-face\n           'cider-stacktrace-filter-inactive-face))))\n\n(defun cider-stacktrace-indicate-filters (filters pos-filters)\n  \"Update enabled state of filter buttons.\n\nFind buttons with a 'filter property; if filter is a member of FILTERS, or\nif filter is nil ('show all') and the argument list is non-nil, fontify the\nbutton as disabled.  Upon finding text with a 'hidden-count property, stop\nsearching and update the hidden count text.  POS-FILTERS is the list of\npositive filters to always include.\"\n  (with-current-buffer cider-error-buffer\n    (save-excursion\n      (goto-char (point-min))\n      (let ((inhibit-read-only t))\n        ;; Toggle buttons\n        (while (not (or (get-text-property (point) 'hidden-count) (eobp)))\n          (let ((button (button-at (point))))\n            (when button\n              (let* ((filter (button-get button 'filter))\n                     (face (cider-stacktrace--face-for-filter filter\n                                                              filters\n                                                              pos-filters)))\n                (button-put button 'face face)))\n            (goto-char (or (next-property-change (point))\n                           (point-max)))))\n        ;; Update hidden count\n        (when (and (get-text-property (point) 'hidden-count)\n                   (re-search-forward \"[0-9]+\" (line-end-position) t))\n          (replace-match\n           (number-to-string cider-stacktrace-hidden-frame-count)))))))\n\n(defun cider-stacktrace-frame-p ()\n  \"Indicate if the text at point is a stack frame.\"\n  (get-text-property (point) 'cider-stacktrace-frame))\n\n(defun cider-stacktrace-collapsed-p ()\n  \"Indicate if the stackframe was collapsed.\"\n  (get-text-property (point) 'collapsed))\n\n(defun cider-stacktrace--should-hide-p (neg-filters pos-filters flags)\n  \"Decide whether a stackframe should be hidden or not.\nNEG-FILTERS dictate which frames should be hidden while POS-FILTERS can\noverride this and ensure that those frames are shown.\nArgument FLAGS are the flags set on the stackframe, ie: clj dup, etc.\"\n  (let ((neg (seq-intersection neg-filters flags))\n        (pos (seq-intersection pos-filters flags))\n        (all (memq 'all pos-filters)))\n    (cond (all nil) ;; if all filter is on then we should not hide\n          ((and pos neg) nil) ;; if hidden and \"resurrected\" we should not hide\n          (pos nil)\n          (neg t)\n          (t nil))))\n\n(defun cider-stacktrace--apply-filters (neg-filters pos-filters)\n  \"Set visibility on stack frames.\nShould be called by `cider-stacktrace-apply-filters' which has the logic of\nhow to interpret the combinations of the positive and negative filters.\nFor instance, the presence of the positive filter `project' requires all of\nthe other negative filters to be applied so that only project frames are\nshown.  NEG-FILTERS are the tags that should be hidden.  POS-FILTERS are\nthe tags that must be shown.\"\n  (with-current-buffer cider-error-buffer\n    (save-excursion\n      (goto-char (point-min))\n      (let ((inhibit-read-only t)\n            (hidden 0))\n        (while (not (eobp))\n          (when (and (cider-stacktrace-frame-p)\n                     (not (cider-stacktrace-collapsed-p)))\n            (let* ((flags (get-text-property (point) 'flags))\n                   (hide (cider-stacktrace--should-hide-p neg-filters\n                                                          pos-filters\n                                                          flags)))\n              (when hide (cl-incf hidden))\n              (put-text-property (point) (line-beginning-position 2)\n                                 'invisible hide)))\n          (forward-line 1))\n        (setq cider-stacktrace-hidden-frame-count hidden)))\n    (cider-stacktrace-indicate-filters neg-filters pos-filters)))\n\n(defun cider-stacktrace-apply-filters (filters)\n  \"Takes a single list of filters and applies them.\nUpdate `cider-stacktrace-hidden-frame-count' and indicate\nfilters applied.  Currently collapsed stacktraces are ignored, and do not\ncontribute to the hidden count.  FILTERS is the list of filters to be\napplied, positive and negative all together.  This function defines how\nthose choices interact and separates them into positive and negative\nfilters for the resulting machinery.\"\n  (let ((neg-filters (seq-intersection filters cider-stacktrace--all-negative-filters))\n        (pos-filters (seq-intersection filters cider-stacktrace--all-positive-filters)))\n    ;; project and all are mutually exclusive. when both are present we check to\n    ;; see the most recent one (as cons onto the list would put it) and use that\n    ;; interaction.\n    (cond\n     ((memq 'all (memq 'project pos-filters)) ;; project is most recent\n      (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters '(project)))\n     ((memq 'project (memq 'all pos-filters)) ;; all is most recent\n      (cider-stacktrace--apply-filters nil '(all)))\n     ((memq 'all pos-filters) (cider-stacktrace--apply-filters nil '(all)))\n     ((memq 'project pos-filters) (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters\n                                                                   pos-filters))\n     (t (cider-stacktrace--apply-filters neg-filters pos-filters)))))\n\n(defun cider-stacktrace-apply-cause-visibility ()\n  \"Apply `cider-stacktrace-cause-visibility' to causes and reapply filters.\"\n  (with-current-buffer cider-error-buffer\n    (save-excursion\n      (goto-char (point-min))\n      (cl-flet ((next-detail (end)\n                             (when-let* ((pos (next-single-property-change (point) 'detail)))\n                               (when (< pos end)\n                                 (goto-char pos)))))\n        (let ((inhibit-read-only t))\n          ;; For each cause...\n          (while (cider-stacktrace-next-cause)\n            (let* ((num   (get-text-property (point) 'cause))\n                   (level (elt cider-stacktrace-cause-visibility num))\n                   (cause-end (cadr (cider-property-bounds 'cause))))\n              ;; For each detail level within the cause, set visibility.\n              (while (next-detail cause-end)\n                (let* ((detail (get-text-property (point) 'detail))\n                       (detail-end (cadr (cider-property-bounds 'detail)))\n                       (hide (if (> detail level) t nil)))\n                  (add-text-properties (point) detail-end\n                                       (list 'invisible hide\n                                             'collapsed hide))))))))\n      (cider-stacktrace-apply-filters cider-stacktrace-filters))))\n\n;;; Internal/Middleware error suppression\n\n(defun cider-stacktrace-some-suppressed-errors-p (error-types)\n  \"Return intersection of ERROR-TYPES and CIDER-STACKTRACE-SUPPRESSED-ERRORS.\nI.e, Return non-nil if the seq ERROR-TYPES shares any elements with\n`cider-stacktrace-suppressed-errors'.  This means that even a\n'well-behaved' (ie, promoted) error type will be 'guilty by association' if\ngrouped with a suppressed error type.\"\n  (seq-intersection error-types cider-stacktrace-suppressed-errors))\n\n(defun cider-stacktrace-suppress-error (error-type)\n  \"Destructively add ERROR-TYPE to the `cider-stacktrace-suppressed-errors' set.\"\n  (setq cider-stacktrace-suppressed-errors\n        (cl-adjoin error-type cider-stacktrace-suppressed-errors :test 'equal)))\n\n(defun cider-stacktrace-promote-error (error-type)\n  \"Destructively remove ERROR-TYPE from `cider-stacktrace-suppressed-errors'.\"\n  (setq cider-stacktrace-suppressed-errors\n        (remove error-type cider-stacktrace-suppressed-errors)))\n\n(defun cider-stacktrace-suppressed-error-p (error-type)\n  \"Return non-nil if ERROR-TYPE is in `cider-stacktrace-suppressed-errors'.\"\n  (member error-type cider-stacktrace-suppressed-errors))\n\n;; Interactive functions\n\n(defun cider-stacktrace-previous-cause ()\n  \"Move point to the previous exception cause, if one exists.\"\n  (interactive)\n  (with-current-buffer cider-error-buffer\n    (when-let* ((pos (previous-single-property-change (point) 'cause)))\n      (goto-char pos))))\n\n(defun cider-stacktrace-next-cause ()\n  \"Move point to the next exception cause, if one exists.\"\n  (interactive)\n  (with-current-buffer cider-error-buffer\n    (when-let* ((pos (next-single-property-change (point) 'cause)))\n      (goto-char pos))))\n\n(defun cider-stacktrace-cycle-cause (num &optional level)\n  \"Update element NUM of `cider-stacktrace-cause-visibility'.\nIf LEVEL is specified, it is used, otherwise its current value is incremented.\nWhen it reaches 3, it wraps to 0.\"\n  (let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num)))))\n    (aset cider-stacktrace-cause-visibility num (mod level 3))\n    (cider-stacktrace-apply-cause-visibility)))\n\n(defun cider-stacktrace-cycle-all-causes ()\n  \"Cycle the visibility of all exception causes.\"\n  (interactive)\n  (with-current-buffer cider-error-buffer\n    (save-excursion\n      ;; Find nearest cause.\n      (unless (get-text-property (point) 'cause)\n        (cider-stacktrace-next-cause)\n        (unless (get-text-property (point) 'cause)\n          (cider-stacktrace-previous-cause)))\n      ;; Cycle its level, and apply that to all causes.\n      (let* ((num (get-text-property (point) 'cause))\n             (level (1+ (elt cider-stacktrace-cause-visibility num))))\n        (setq-local cider-stacktrace-cause-visibility\n                    (make-vector 10 (mod level 3)))\n        (cider-stacktrace-apply-cause-visibility)))))\n\n(defun cider-stacktrace-cycle-current-cause ()\n  \"Cycle the visibility of current exception at point, if any.\"\n  (interactive)\n  (with-current-buffer cider-error-buffer\n    (when-let* ((num (get-text-property (point) 'cause)))\n      (cider-stacktrace-cycle-cause num))))\n\n(defun cider-stacktrace-cycle-cause-1 ()\n  \"Cycle the visibility of exception cause #1.\"\n  (interactive)\n  (cider-stacktrace-cycle-cause 1))\n\n(defun cider-stacktrace-cycle-cause-2 ()\n  \"Cycle the visibility of exception cause #2.\"\n  (interactive)\n  (cider-stacktrace-cycle-cause 2))\n\n(defun cider-stacktrace-cycle-cause-3 ()\n  \"Cycle the visibility of exception cause #3.\"\n  (interactive)\n  (cider-stacktrace-cycle-cause 3))\n\n(defun cider-stacktrace-cycle-cause-4 ()\n  \"Cycle the visibility of exception cause #4.\"\n  (interactive)\n  (cider-stacktrace-cycle-cause 4))\n\n(defun cider-stacktrace-cycle-cause-5 ()\n  \"Cycle the visibility of exception cause #5.\"\n  (interactive)\n  (cider-stacktrace-cycle-cause 5))\n\n(defun cider-stacktrace-toggle (flag)\n  \"Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters.\"\n  (cider-stacktrace-apply-filters\n   (setq cider-stacktrace-filters\n         (if (memq flag cider-stacktrace-filters)\n             (remq flag cider-stacktrace-filters)\n           (cons flag cider-stacktrace-filters)))))\n\n(defun cider-stacktrace-toggle-all ()\n  \"Toggle `all' in filter list.\"\n  (interactive)\n  (cider-stacktrace-toggle 'all))\n\n(defun cider-stacktrace-show-only-project ()\n  \"Display only the stackframes from the project.\"\n  (interactive)\n  (cider-stacktrace-toggle 'project))\n\n(defun cider-stacktrace-toggle-java ()\n  \"Toggle display of Java stack frames.\"\n  (interactive)\n  (cider-stacktrace-toggle 'java))\n\n(defun cider-stacktrace-toggle-clj ()\n  \"Toggle display of Clojure stack frames.\"\n  (interactive)\n  (cider-stacktrace-toggle 'clj))\n\n(defun cider-stacktrace-toggle-repl ()\n  \"Toggle display of REPL stack frames.\"\n  (interactive)\n  (cider-stacktrace-toggle 'repl))\n\n(defun cider-stacktrace-toggle-tooling ()\n  \"Toggle display of Tooling stack frames (compiler, nREPL middleware, etc).\"\n  (interactive)\n  (cider-stacktrace-toggle 'tooling))\n\n(defun cider-stacktrace-toggle-duplicates ()\n  \"Toggle display of stack frames that are duplicates of their descendents.\"\n  (interactive)\n  (cider-stacktrace-toggle 'dup))\n\n;; Text button functions\n\n(defun cider-stacktrace-filter (button)\n  \"Apply filter(s) indicated by the BUTTON.\"\n  (with-temp-message \"Filters may also be toggled with the keyboard.\"\n    (let ((flag (button-get button 'filter)))\n      (cond ((member flag cider-stacktrace--all-negative-filters)\n             (cider-stacktrace-toggle flag))\n            ((member flag cider-stacktrace--all-positive-filters)\n             (cider-stacktrace-show-only-project))\n            (t (cider-stacktrace-toggle-all))))\n    (sit-for 5)))\n\n(defun cider-stacktrace-toggle-suppression (button)\n  \"Toggle stacktrace pop-over/pop-under behavior for the `error-type' in BUTTON.\nAchieved by destructively manipulating `cider-stacktrace-suppressed-errors'.\"\n  (with-current-buffer cider-error-buffer\n    (let ((inhibit-read-only t)\n          (suppressed (button-get button 'suppressed))\n          (error-type (button-get button 'error-type)))\n      (if suppressed\n          (progn\n            (cider-stacktrace-promote-error error-type)\n            (button-put button 'face 'cider-stacktrace-promoted-button-face)\n            (button-put button 'help-echo \"Click to suppress these stacktraces.\"))\n        (cider-stacktrace-suppress-error error-type)\n        (button-put button 'face 'cider-stacktrace-suppressed-button-face)\n        (button-put button 'help-echo \"Click to promote these stacktraces.\"))\n      (button-put button 'suppressed (not suppressed)))))\n\n(defun cider-stacktrace-navigate (button)\n  \"Navigate to the stack frame source represented by the BUTTON.\"\n  (let* ((var (button-get button 'var))\n         (class (button-get button 'class))\n         (method (button-get button 'method))\n         (info (or (and var (cider-var-info var))\n                   (and class method (cider-member-info class method))\n                   (nrepl-dict)))\n         ;; Stacktrace returns more accurate line numbers, but if the function's\n         ;; line was unreliable, then so is the stacktrace by the same amount.\n         ;; Set `line-shift' to the number of lines from the beginning of defn.\n         (line-shift (- (or (button-get button 'line) 0)\n                        (or (nrepl-dict-get info \"line\") 1)))\n         (file (or\n                (nrepl-dict-get info \"file\")\n                (button-get button 'file)))\n         ;; give priority to `info` files as `info` returns full paths.\n         (info (nrepl-dict-put info \"file\" file)))\n    (cider--jump-to-loc-from-info info t)\n    (forward-line line-shift)\n    (back-to-indentation)))\n\n(declare-function cider-find-var \"cider-find\")\n\n(defun cider-stacktrace-jump (&optional arg)\n  \"Find definition for stack frame at point, if available.\nThe prefix ARG and `cider-prompt-for-symbol' decide whether to\nprompt and whether to use a new window.  Similar to `cider-find-var'.\"\n  (interactive \"P\")\n  (let ((button (button-at (point))))\n    (if (and button (button-get button 'line))\n        (cider-stacktrace-navigate button)\n      (cider-find-var arg))))\n\n\n;; Rendering\n(defvar cider-use-tooltips)\n(defun cider-stacktrace-tooltip (tooltip)\n  \"Return TOOLTIP if `cider-use-tooltips' is set to true, nil otherwise.\"\n  (when cider-use-tooltips tooltip))\n\n(defun cider-stacktrace-emit-indented (text &optional indent fill fontify)\n  \"Insert TEXT, and optionally FILL and FONTIFY as clojure the entire block.\nINDENT is a string to insert before each line.  When INDENT is nil, first\nline is not indented and INDENT defaults to a white-spaced string with\nlength given by `current-column'.\"\n  (let ((text (if fontify\n                  (cider-font-lock-as-clojure text)\n                text))\n        (do-first indent)\n        (indent (or indent (make-string (current-column) ? )))\n        (beg (point)))\n    (insert text)\n    (goto-char beg)\n    (when do-first\n      (insert indent))\n    (forward-line)\n    (while (not (eobp))\n      (insert indent)\n      (forward-line))\n    (when (and fill cider-stacktrace-fill-column)\n      (when (and (numberp cider-stacktrace-fill-column))\n        (setq-local fill-column cider-stacktrace-fill-column))\n      (setq-local fill-prefix indent)\n      (fill-region beg (point)))))\n\n(defun cider-stacktrace-render-filters (buffer special-filters filters)\n  \"Emit into BUFFER toggle buttons for each of the FILTERS.\nSPECIAL-FILTERS are filters that show stack certain stack frames, hiding\nothers.\"\n  (with-current-buffer buffer\n    (insert \"  Show: \")\n    (dolist (filter special-filters)\n      (insert-text-button (car filter)\n                          'filter (cadr filter)\n                          'follow-link t\n                          'action #'cider-stacktrace-filter\n                          'help-echo (cider-stacktrace-tooltip\n                                      (format \"Toggle %s stack frames\"\n                                              (car filter))))\n      (insert \" \"))\n    (insert \"\\n\")\n    (insert \"  Hide: \")\n    (dolist (filter filters)\n      (insert-text-button (car filter)\n                          'filter (cadr filter)\n                          'follow-link t\n                          'action #'cider-stacktrace-filter\n                          'help-echo (cider-stacktrace-tooltip\n                                      (format \"Toggle %s stack frames\"\n                                              (car filter))))\n      (insert \" \"))\n\n    (let ((hidden \"(0 frames hidden)\"))\n      (put-text-property 0 (length hidden) 'hidden-count t hidden)\n      (insert \" \" hidden \"\\n\"))))\n\n(defun cider-stacktrace-render-suppression-toggle (buffer error-types)\n  \"Emit toggle buttons for each of the ERROR-TYPES leading this stacktrace BUFFER.\"\n  (with-current-buffer buffer\n    (when error-types\n      (insert \"  This is an unexpected CIDER middleware error.\\n  Please submit a bug report via `\")\n      (insert-text-button \"M-x cider-report-bug\"\n                          'follow-link t\n                          'action (lambda (_button) (cider-report-bug))\n                          'help-echo (cider-stacktrace-tooltip\n                                      \"Report bug to the CIDER team.\"))\n      (insert \"`.\\n\\n\")\n      (insert \"\\\n  If these stacktraces are occurring frequently, consider using the\n  button(s) below to suppress these types of errors for the duration of\n  your current CIDER session. The stacktrace buffer will still be\n  generated, but it will \\\"pop under\\\" your current buffer instead of\n  \\\"popping over\\\". The button toggles this behavior.\\n\\n \")\n      (dolist (error-type error-types)\n        (let ((suppressed (cider-stacktrace-suppressed-error-p error-type)))\n          (insert-text-button (format \"%s %s\" (if suppressed \"Promote\" \"Suppress\") error-type)\n                              'follow-link t\n                              'error-type error-type\n                              'action #'cider-stacktrace-toggle-suppression\n                              'suppressed suppressed\n                              'face (if suppressed\n                                        'cider-stacktrace-suppressed-button-face\n                                      'cider-stacktrace-promoted-button-face)\n                              'help-echo (cider-stacktrace-tooltip\n                                          (format \"Click to %s these stacktraces.\"\n                                                  (if suppressed \"promote\" \"suppress\")))))\n        (insert \" \")))))\n\n(defun cider-stacktrace-render-frame (buffer frame)\n  \"Emit into BUFFER function call site info for the stack FRAME.\nThis associates text properties to enable filtering and source navigation.\"\n  (with-current-buffer buffer\n    (if (null frame) ;; Probably caused by OmitStackTraceInFastThrow\n        (let ((url \"https://docs.cider.mx/cider/troubleshooting.html#empty-java-stacktraces\"))\n          (insert \"  No stacktrace available!\\n  Please see \")\n          (insert-text-button url\n                              'url url\n                              'follow-link t\n                              'action (lambda (x) (browse-url (button-get x 'url)))))\n      (nrepl-dbind-response frame (file line flags class method name var ns fn)\n        (let ((flags (mapcar #'intern flags))) ; strings -> symbols\n          (insert-text-button (format \"%26s:%5d  %s/%s\"\n                                      (if (member 'repl flags) \"REPL\" file) line\n                                      (if (member 'clj flags) ns class)\n                                      (if (member 'clj flags) fn method))\n                              'var var 'class class 'method method\n                              'name name 'file file 'line line\n                              'flags flags 'follow-link t\n                              'action #'cider-stacktrace-navigate\n                              'help-echo (cider-stacktrace-tooltip\n                                          \"View source at this location\")\n                              'font-lock-face 'cider-stacktrace-face\n                              'type 'cider-plain-button)\n          (save-excursion\n            (let ((p4 (point))\n                  (p1 (search-backward \" \"))\n                  (p2 (search-forward \"/\"))\n                  (p3 (search-forward-regexp \"[^/$]+\")))\n              (put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face)\n              (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face)\n              (put-text-property (line-beginning-position) (line-end-position)\n                                 'cider-stacktrace-frame t)))\n          (insert \"\\n\"))))))\n\n(defun cider-stacktrace-render-compile-error (buffer cause)\n  \"Emit into BUFFER the compile error CAUSE, and enable jumping to it.\"\n  (with-current-buffer buffer\n    (nrepl-dbind-response cause (file path line column)\n      (let ((indent \"   \")\n            (message-face 'cider-stacktrace-error-message-face))\n        (insert indent)\n        (insert (propertize \"Error compiling \" 'font-lock-face  message-face))\n        (insert-text-button path 'compile-error t\n                            'file file 'line line 'column column 'follow-link t\n                            'action (lambda (_button)\n                                      (cider-jump-to (cider-find-file file)\n                                                     (cons line column)))\n                            'help-echo (cider-stacktrace-tooltip\n                                        \"Jump to the line that caused the error\"))\n        (insert (propertize (format \" at (%d:%d)\" line column)\n                            'font-lock-face message-face))))))\n\n(defun cider-stacktrace--toggle-visibility (id)\n  \"Toggle visibility of the region with ID invisibility prop.\nID can also be a button, in which case button's property :id is used\ninstead.  This function can be used directly in button actions.\"\n  (let ((id (if (or (numberp id) (symbolp id))\n                ;; There is no proper way to identify buttons. Assuming that\n                ;; id's can be either numbers or symbols.\n                id\n              (button-get id :id))))\n    (if (and (consp buffer-invisibility-spec)\n             (assoc id buffer-invisibility-spec))\n        (remove-from-invisibility-spec (cons id t))\n      (add-to-invisibility-spec (cons id t)))))\n\n(defun cider-stacktrace--insert-named-group (indent name &rest vals)\n  \"Insert named group with the ability to toggle visibility.\nNAME is a string naming the group.  VALS are strings to be inserted after\nthe NAME.  The whole group is prefixed by string INDENT.\"\n  (let* ((str (and vals (replace-regexp-in-string \"\\n+\\\\'\" \"\" (apply #'concat vals))))\n         (id (and str\n                  (string-match \"\\n\" str)\n                  (cl-gensym name))))\n    (insert indent)\n    (if id\n        (let* ((beg-link (string-match \"[^ :]\" name))\n               (end-link (string-match \"[ :]\" name (1+ beg-link))))\n          (insert (substring name 0 beg-link))\n          (insert-text-button (substring name beg-link end-link)\n                              :id id\n                              'face '((:weight bold) (:underline t))\n                              'follow-link t\n                              'help-echo \"Toggle visibility\"\n                              'action #'cider-stacktrace--toggle-visibility)\n          (insert (substring name end-link)))\n      (insert (propertize name 'face '((:weight bold)))))\n    (let ((pos (point)))\n      (when str\n        (cider-stacktrace-emit-indented (concat str \"\\n\") nil nil t)\n        (when id\n          (remove-from-invisibility-spec (cons id t))\n          (let ((hide-beg (save-excursion (goto-char pos) (point-at-eol)))\n                (hide-end (1- (point-at-bol))))\n            (overlay-put (make-overlay hide-beg hide-end) 'invisible id)))))))\n\n(defun cider-stacktrace--emit-spec-problems (spec-data indent)\n  \"Emit SPEC-DATA indented with INDENT.\"\n  (nrepl-dbind-response spec-data (spec value problems)\n    (insert \"\\n\")\n    (cider-stacktrace--insert-named-group indent \"    Spec: \" spec)\n    (cider-stacktrace--insert-named-group indent \"   Value: \" value)\n    (insert \"\\n\")\n    (cider-stacktrace--insert-named-group indent \"Problems: \\n\")\n    (let ((indent2 (concat indent \"    \")))\n      (dolist (prob problems)\n        (nrepl-dbind-response prob (in val predicate reason spec at extra)\n          (insert \"\\n\")\n          (when (not (string= val value))\n            (cider-stacktrace--insert-named-group indent2 \"   val: \" val))\n          (when in\n            (cider-stacktrace--insert-named-group indent2 \"    in: \" in))\n          (cider-stacktrace--insert-named-group indent2   \"failed: \" predicate)\n          (when spec\n            (cider-stacktrace--insert-named-group indent2 \"  spec: \" spec))\n          (when at\n            (cider-stacktrace--insert-named-group indent2 \"    at: \" at))\n          (when reason\n            (cider-stacktrace--insert-named-group indent2 \"reason: \" reason))\n          (when extra\n            (cider-stacktrace--insert-named-group indent2 \"extras: \\n\")\n            (cider-stacktrace-emit-indented extra (concat indent2 \"  \") nil t)))))))\n\n(defun cider-stacktrace-render-cause (buffer cause num note)\n  \"Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE.\"\n  (with-current-buffer buffer\n    (nrepl-dbind-response cause (class message data spec stacktrace)\n      (let ((indent \"   \")\n            (class-face 'cider-stacktrace-error-class-face)\n            (message-face 'cider-stacktrace-error-message-face))\n        (cider-propertize-region `(cause ,num)\n          ;; Detail level 0: exception class\n          (cider-propertize-region '(detail 0)\n            (insert (format \"%d. \" num)\n                    (propertize note 'font-lock-face 'font-lock-comment-face) \" \"\n                    (propertize class 'font-lock-face class-face)\n                    \"\\n\"))\n          ;; Detail level 1: message + ex-data\n          (cider-propertize-region '(detail 1)\n            (if (equal class \"clojure.lang.Compiler$CompilerException\")\n                (cider-stacktrace-render-compile-error buffer cause)\n              (cider-stacktrace-emit-indented\n               (propertize (or message \"(No message)\")\n                           'font-lock-face  message-face)\n               indent t))\n            (insert \"\\n\")\n            (when spec\n              (cider-stacktrace--emit-spec-problems spec (concat indent \"  \")))\n            (when data\n              (cider-stacktrace-emit-indented data indent nil t)))\n          ;; Detail level 2: stacktrace\n          (cider-propertize-region '(detail 2)\n            (insert \"\\n\")\n            (let ((beg (point))\n                  (bg `(:background ,cider-stacktrace-frames-background-color :extend t)))\n              (dolist (frame stacktrace)\n                (cider-stacktrace-render-frame buffer frame))\n              (overlay-put (make-overlay beg (point)) 'font-lock-face bg)))\n          ;; Add line break between causes, even when collapsed.\n          (cider-propertize-region '(detail 0)\n            (insert \"\\n\")))))))\n\n(defun cider-stacktrace-initialize (causes)\n  \"Set and apply CAUSES initial visibility, filters, and cursor position.\"\n  (nrepl-dbind-response (car causes) (class)\n    (let ((compile-error-p (equal class \"clojure.lang.Compiler$CompilerException\")))\n      ;; Partially display outermost cause if it's a compiler exception (the\n      ;; description reports reader location of the error).\n      (when compile-error-p\n        (cider-stacktrace-cycle-cause (length causes) 1))\n      ;; Fully display innermost cause. This also applies visibility/filters.\n      (cider-stacktrace-cycle-cause 1 cider-stacktrace-detail-max)\n      ;; Move point (DWIM) to the compile error location if present, or to the\n      ;; first stacktrace frame in displayed cause otherwise. If the error\n      ;; buffer is visible in a window, ensure that window is selected while moving\n      ;; point, so as to move both the buffer's and the window's point.\n      (with-selected-window (or (get-buffer-window cider-error-buffer)\n                                (selected-window))\n        (with-current-buffer cider-error-buffer\n          (goto-char (point-min))\n          (if compile-error-p\n              (goto-char (next-single-property-change (point) 'compile-error))\n            (progn\n              (while (cider-stacktrace-next-cause))\n              (goto-char (next-single-property-change (point) 'flags)))))))))\n\n(defun cider-stacktrace-render (buffer causes &optional error-types)\n  \"Emit into BUFFER useful stacktrace information for the CAUSES.\nTakes an optional ERROR-TYPES list which will render a 'suppression' toggle\nthat alters the pop-over/pop-under behavorior of the stacktrace buffers\ncreated by these types of errors.  The suppressed errors set can be customized\nthrough the `cider-stacktrace-suppressed-errors' variable.\"\n  (with-current-buffer buffer\n    (let ((inhibit-read-only t))\n      (erase-buffer)\n      (insert \"\\n\")\n      ;; Stacktrace filters\n      (cider-stacktrace-render-filters\n       buffer\n       `((\"Project-Only\" project) (\"All\" all))\n       `((\"Clojure\" clj) (\"Java\" java) (\"REPL\" repl)\n         (\"Tooling\" tooling) (\"Duplicates\" dup)))\n      (insert \"\\n\")\n      ;; Option to suppress internal/middleware errors\n      (when error-types\n        (cider-stacktrace-render-suppression-toggle buffer error-types)\n        (insert \"\\n\\n\"))\n      ;; Stacktrace exceptions & frames\n      (let ((num (length causes)))\n        (dolist (cause causes)\n          (let ((note (if (= num (length causes)) \"Unhandled\" \"Caused by\")))\n            (cider-stacktrace-render-cause buffer cause num note)\n            (setq num (1- num))))))\n    (cider-stacktrace-initialize causes)\n    (font-lock-refresh-defaults)))\n\n(provide 'cider-stacktrace)\n\n;;; cider-stacktrace.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-test.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52937749,"end":52937786},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52937786},"to":{"change":3,"start":52903104,"end":52903104},"introduced_by":3}],"inode":{"change":3,"pos":52903104}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52903104},"to":{"change":3,"start":52903105,"end":52937748},"introduced_by":3}],"inode":{"change":3,"pos":52903104}},"content":[{"Del":";;; cider-test.el --- Test result viewer -*- lexical-binding: t -*-\n\n;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors\n\n;; Author: Jeff Valk \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; This provides execution, reporting, and navigation support for Clojure tests,\n;; specifically using the `clojure.test' machinery.  This functionality replaces\n;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on\n;; nREPL middleware for report running and session support.\n\n;;; Code:\n\n(require 'ansi-color)\n(require 'button)\n(require 'cl-lib)\n(require 'easymenu)\n(require 'map)\n(require 'seq)\n(require 'subr-x)\n\n(require 'cider-common)\n(require 'cider-client)\n(require 'cider-popup)\n(require 'cider-stacktrace)\n(require 'cider-overlays)\n\n;;; Variables\n\n(defgroup cider-test nil\n  \"Presentation and navigation for test results.\"\n  :prefix \"cider-test-\"\n  :group 'cider)\n\n(defcustom cider-test-show-report-on-success nil\n  \"Whether to show the `*cider-test-report*` buffer on passing tests.\"\n  :type 'boolean\n  :package-version '(cider . \"0.8.0\"))\n\n(defcustom cider-auto-select-test-report-buffer t\n  \"Determines if the test-report buffer should be auto-selected.\"\n  :type 'boolean\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-test-defining-forms '(\"deftest\" \"defspec\")\n  \"Forms that define individual tests.\nCIDER considers the \\\"top-level\\\" form around point to define a test if\nthe form starts with one of these forms.\nAdd to this list to have CIDER recognize additional test defining macros.\"\n  :type '(repeat string)\n  :package-version '(cider . \"0.15.0\"))\n\n(defvar cider-test-last-summary nil\n  \"The summary of the last run test.\")\n\n(defvar cider-test-last-results nil\n  \"The results of the last run test.\")\n\n(defconst cider-test-report-buffer \"*cider-test-report*\"\n  \"Buffer name in which to display test reports.\")\n\n;;; Faces\n\n(defface cider-test-failure-face\n  '((((class color) (background light))\n     :background \"orange red\")\n    (((class color) (background dark))\n     :background \"firebrick\"))\n  \"Face for failed tests.\"\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-test-error-face\n  '((((class color) (background light))\n     :background \"orange1\")\n    (((class color) (background dark))\n     :background \"orange4\"))\n  \"Face for erring tests.\"\n  :package-version '(cider . \"0.7.0\"))\n\n(defface cider-test-success-face\n  '((((class color) (background light))\n     :foreground \"black\"\n     :background \"green\")\n    (((class color) (background dark))\n     :foreground \"black\"\n     :background \"green\"))\n  \"Face for passing tests.\"\n  :package-version '(cider . \"0.7.0\"))\n\n\n;; Colors & Theme Support\n\n(defvar cider-test-items-background-color\n  (cider-scale-background-color)\n  \"Background color for test assertion items.\")\n\n(advice-add 'enable-theme  :after #'cider--test-adapt-to-theme)\n(advice-add 'disable-theme :after #'cider--test-adapt-to-theme)\n(defun cider--test-adapt-to-theme (&rest _)\n  \"When theme is changed, update `cider-test-items-background-color'.\"\n  (setq cider-test-items-background-color (cider-scale-background-color)))\n\n\n;;; Report mode & key bindings\n;;\n;; The primary mode of interacting with test results is the report buffer, which\n;; allows navigation among tests, jumping to test definitions, expected/actual\n;; diff-ing, and cause/stacktrace inspection for test errors.\n\n(defvar cider-test-commands-map\n  (let ((map (define-prefix-command 'cider-test-commands-map)))\n    ;; Duplicates of keys below with C- for convenience\n    (define-key map (kbd \"C-r\") #'cider-test-rerun-failed-tests)\n    (define-key map (kbd \"C-t\") #'cider-test-run-test)\n    (define-key map (kbd \"C-a\") #'cider-test-rerun-test)\n    (define-key map (kbd \"C-n\") #'cider-test-run-ns-tests)\n    (define-key map (kbd \"C-s\") #'cider-test-run-ns-tests-with-filters)\n    (define-key map (kbd \"C-l\") #'cider-test-run-loaded-tests)\n    (define-key map (kbd \"C-p\") #'cider-test-run-project-tests)\n    (define-key map (kbd \"C-b\") #'cider-test-show-report)\n    ;; Single-key bindings defined last for display in menu\n    (define-key map (kbd \"r\")   #'cider-test-rerun-failed-tests)\n    (define-key map (kbd \"t\")   #'cider-test-run-test)\n    (define-key map (kbd \"a\")   #'cider-test-rerun-test)\n    (define-key map (kbd \"n\")   #'cider-test-run-ns-tests)\n    (define-key map (kbd \"s\")   #'cider-test-run-ns-tests-with-filters)\n    (define-key map (kbd \"l\")   #'cider-test-run-loaded-tests)\n    (define-key map (kbd \"p\")   #'cider-test-run-project-tests)\n    (define-key map (kbd \"b\")   #'cider-test-show-report)\n    map))\n\n(defconst cider-test-menu\n  '(\"Test\"\n    [\"Run test\" cider-test-run-test]\n    [\"Run namespace tests\" cider-test-run-ns-tests]\n    [\"Run namespace tests with filters\" cider-test-run-ns-tests-with-filters]\n    [\"Run all loaded tests\" cider-test-run-loaded-tests]\n    [\"Run all loaded tests with filters\" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)]\n    [\"Run all project tests\" cider-test-run-project-tests]\n    [\"Run all project tests with filters\" (apply-partially cider-test-run-project-tests 'prompt-for-filters)]\n    [\"Run tests after load-file\" cider-auto-test-mode\n     :style toggle :selected cider-auto-test-mode]\n    \"--\"\n    [\"Interrupt running tests\" cider-interrupt]\n    [\"Rerun failed/erring tests\" cider-test-rerun-failed-tests]\n    [\"Show test report\" cider-test-show-report]\n    \"--\"\n    [\"Configure testing\" (customize-group 'cider-test)])\n  \"CIDER test submenu.\")\n\n(defvar cider-test-report-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"C-c ,\")   'cider-test-commands-map)\n    (define-key map (kbd \"C-c C-t\") 'cider-test-commands-map)\n    (define-key map (kbd \"M-p\") #'cider-test-previous-result)\n    (define-key map (kbd \"M-n\") #'cider-test-next-result)\n    (define-key map (kbd \"M-.\") #'cider-test-jump)\n    (define-key map (kbd \"\") #'cider-test-previous-result)\n    (define-key map (kbd \"TAB\") #'cider-test-next-result)\n    (define-key map (kbd \"RET\") #'cider-test-jump)\n    (define-key map (kbd \"t\") #'cider-test-jump)\n    (define-key map (kbd \"d\") #'cider-test-ediff)\n    (define-key map (kbd \"e\") #'cider-test-stacktrace)\n    ;; `f' for \"run failed\".\n    (define-key map \"f\" #'cider-test-rerun-failed-tests)\n    (define-key map \"n\" #'cider-test-run-ns-tests)\n    (define-key map \"s\" #'cider-test-run-ns-tests-with-filters)\n    (define-key map \"l\" #'cider-test-run-loaded-tests)\n    (define-key map \"p\" #'cider-test-run-project-tests)\n    ;; `g' generally reloads the buffer.  The closest thing we have to that is\n    ;; \"run the test at point\".  But it's not as nice as rerunning all tests in\n    ;; this buffer.\n    (define-key map \"g\" #'cider-test-run-test)\n    (define-key map \"q\" #'cider-popup-buffer-quit-function)\n    (easy-menu-define cider-test-report-mode-menu map\n      \"Menu for CIDER's test result mode\"\n      '(\"Test-Report\"\n        [\"Previous result\" cider-test-previous-result]\n        [\"Next result\" cider-test-next-result]\n        \"--\"\n        [\"Rerun current test\" cider-test-run-test]\n        [\"Rerun failed/erring tests\" cider-test-rerun-failed-tests]\n        [\"Run all ns tests\" cider-test-run-ns-tests]\n        [\"Run all ns tests with filters\" cider-test-run-ns-tests-with-filters]\n        [\"Run all loaded tests\" cider-test-run-loaded-tests]\n        [\"Run all loaded tests with filters\" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)]\n        [\"Run all project tests\" cider-test-run-project-tests]\n        [\"Run all project tests with filters\" (apply-partially cider-test-run-project-tests 'prompt-for-filters)]\n        \"--\"\n        [\"Jump to test definition\" cider-test-jump]\n        [\"Display test error\" cider-test-stacktrace]\n        [\"Display expected/actual diff\" cider-test-ediff]))\n    map))\n\n(define-derived-mode cider-test-report-mode fundamental-mode \"Test Report\"\n  \"Major mode for presenting Clojure test results.\n\n\\\\{cider-test-report-mode-map}\"\n  (setq buffer-read-only t)\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t))\n  (setq-local sesman-system 'CIDER)\n  (setq-local electric-indent-chars nil)\n  (buffer-disable-undo))\n\n;; Report navigation\n\n(defun cider-test-show-report ()\n  \"Show the test report buffer, if one exists.\"\n  (interactive)\n  (if-let* ((report-buffer (get-buffer cider-test-report-buffer)))\n      (switch-to-buffer report-buffer)\n    (message \"No test report buffer\")))\n\n(defun cider-test-previous-result ()\n  \"Move point to the previous test result, if one exists.\"\n  (interactive)\n  (with-current-buffer (get-buffer cider-test-report-buffer)\n    (when-let* ((pos (previous-single-property-change (point) 'type)))\n      (if (get-text-property pos 'type)\n          (goto-char pos)\n        (when-let* ((pos (previous-single-property-change pos 'type)))\n          (goto-char pos))))))\n\n(defun cider-test-next-result ()\n  \"Move point to the next test result, if one exists.\"\n  (interactive)\n  (with-current-buffer (get-buffer cider-test-report-buffer)\n    (when-let* ((pos (next-single-property-change (point) 'type)))\n      (if (get-text-property pos 'type)\n          (goto-char pos)\n        (when-let* ((pos (next-single-property-change pos 'type)))\n          (goto-char pos))))))\n\n(declare-function cider-find-var \"cider-find\")\n\n(defun cider-test-jump (&optional arg)\n  \"Find definition for test at point, if available.\nThe prefix ARG and `cider-prompt-for-symbol' decide whether to\nprompt and whether to use a new window.  Similar to `cider-find-var'.\"\n  (interactive \"P\")\n  (let ((ns   (get-text-property (point) 'ns))\n        (var  (get-text-property (point) 'var))\n        (line (get-text-property (point) 'line)))\n    (if (and ns var)\n        (cider-find-var arg (concat ns \"/\" var) line)\n      (cider-find-var arg))))\n\n;;; Error stacktraces\n\n(defvar cider-auto-select-error-buffer)\n\n(defun cider-test-stacktrace-for (ns var index)\n  \"Display stacktrace for the erring NS VAR test with the assertion INDEX.\"\n  (let (causes)\n    (cider-nrepl-send-request\n     (thread-last\n       (map-merge 'list\n                  `((\"op\" \"test-stacktrace\")\n                    (\"ns\" ,ns)\n                    (\"var\" ,var)\n                    (\"index\" ,index))\n                  (cider--nrepl-print-request-map fill-column))\n       (seq-mapcat #'identity))\n     (lambda (response)\n       (nrepl-dbind-response response (class status)\n         (cond (class  (setq causes (cons response causes)))\n               (status (when causes\n                         (cider-stacktrace-render\n                          (cider-popup-buffer cider-error-buffer\n                                              cider-auto-select-error-buffer\n                                              #'cider-stacktrace-mode\n                                              'ancillary)\n                          (reverse causes))))))))))\n\n(defun cider-test-stacktrace ()\n  \"Display stacktrace for the erring test at point.\"\n  (interactive)\n  (let ((ns    (get-text-property (point) 'ns))\n        (var   (get-text-property (point) 'var))\n        (index (get-text-property (point) 'index))\n        (err   (get-text-property (point) 'error)))\n    (if (and err ns var index)\n        (cider-test-stacktrace-for ns var index)\n      (message \"No test error at point\"))))\n\n\n;;; Expected vs actual diffing\n\n(defvar cider-test-ediff-buffers nil\n  \"The expected/actual buffers used to display diff.\")\n\n(defun cider-test--extract-from-actual (actual n)\n  \"Extract form N from ACTUAL, ignoring outermost not.\n\nACTUAL is a string like \\\"(not (= 3 4))\\\", of the sort returned by\nclojure.test.\n\nN = 1 => 3, N = 2 => 4, etc.\"\n  (with-temp-buffer\n    (insert actual)\n    (clojure-mode)\n    (goto-char (point-min))\n    (re-search-forward \"(\" nil t 2)\n    (clojure-forward-logical-sexp n)\n    (forward-whitespace 1)\n    (let ((beg (point)))\n      (clojure-forward-logical-sexp)\n      (buffer-substring beg (point)))))\n\n(defun cider-test-ediff ()\n  \"Show diff of the expected vs actual value for the test at point.\nWith the actual value, the outermost '(not ...)' s-expression is removed.\"\n  (interactive)\n  (let* ((expected-buffer (generate-new-buffer \" *expected*\"))\n         (actual-buffer   (generate-new-buffer \" *actual*\"))\n         (diffs (get-text-property (point) 'diffs))\n         (actual* (get-text-property (point) 'actual))\n         (expected (cond (diffs (get-text-property (point) 'expected))\n                         (actual* (cider-test--extract-from-actual actual* 1))))\n         (actual (cond (diffs (caar diffs))\n                       (actual* (cider-test--extract-from-actual actual* 2)))))\n    (if (not (and expected actual))\n        (message \"No test failure at point\")\n      (with-current-buffer expected-buffer\n        (insert expected)\n        (clojure-mode))\n      (with-current-buffer actual-buffer\n        (insert actual)\n        (clojure-mode))\n      (apply #'ediff-buffers\n             (setq cider-test-ediff-buffers\n                   (list (buffer-name expected-buffer)\n                         (buffer-name actual-buffer)))))))\n\n(defun cider-test-ediff-cleanup ()\n  \"Cleanup expected/actual buffers used for diff.\"\n  (interactive)\n  (mapc (lambda (b) (when (get-buffer b) (kill-buffer b)))\n        cider-test-ediff-buffers))\n\n(add-hook 'ediff-cleanup-hook #'cider-test-ediff-cleanup)\n\n\n;;; Report rendering\n\n(defun cider-test-type-face (type)\n  \"Return the font lock face for the test result TYPE.\"\n  (pcase type\n    (\"pass\"  'cider-test-success-face)\n    (\"fail\"  'cider-test-failure-face)\n    (\"error\" 'cider-test-error-face)\n    (_       'default)))\n\n(defun cider-test-type-simple-face (type)\n  \"Return a face for the test result TYPE using the highlight color as foreground.\"\n  (let ((face (cider-test-type-face type)))\n    `(:foreground ,(face-attribute face :background))))\n\n(defun cider-test-render-summary (buffer summary)\n  \"Emit into BUFFER the report SUMMARY statistics.\"\n  (with-current-buffer buffer\n    (nrepl-dbind-response summary (ns var test pass fail error)\n      (insert (format \"Tested %d namespaces\\n\" ns))\n      (insert (format \"Ran %d assertions, in %d test functions\\n\" test var))\n      (unless (zerop fail)\n        (cider-insert (format \"%d failures\" fail) 'cider-test-failure-face t))\n      (unless (zerop error)\n        (cider-insert (format \"%d errors\" error) 'cider-test-error-face t))\n      (when (zerop (+ fail error))\n        (cider-insert (format \"%d passed\" pass) 'cider-test-success-face t))\n      (insert \"\\n\\n\"))))\n\n(defun cider-test-render-assertion (buffer test)\n  \"Emit into BUFFER report detail for the TEST assertion.\"\n  (with-current-buffer buffer\n    (nrepl-dbind-response test (var context type message expected actual diffs error gen-input)\n      (cl-flet ((insert-label (s)\n                  (cider-insert (format \"%8s: \" s) 'font-lock-comment-face))\n                (insert-align-label (s)\n                  (insert (format \"%12s\" s)))\n                (insert-rect (s)\n                  (let ((start (point)))\n                    (insert-rectangle (thread-first\n                                        s\n                                        cider-font-lock-as-clojure\n                                        (split-string \"\\n\")))\n                    (ansi-color-apply-on-region start (point)))\n                  (beginning-of-line)))\n        (cider-propertize-region (cider-intern-keys (cdr test))\n          (let ((beg (point))\n                (type-face (cider-test-type-simple-face type))\n                (bg `(:background ,cider-test-items-background-color :extend t)))\n            (cider-insert (capitalize type) type-face nil \" in \")\n            (cider-insert var 'font-lock-function-name-face t)\n            (when context  (cider-insert context 'font-lock-doc-face t))\n            (when message  (cider-insert message 'font-lock-string-face t))\n            (when expected\n              (insert-label \"expected\")\n              (insert-rect expected)\n              (insert \"\\n\"))\n            (if diffs\n                (dolist (d diffs)\n                  (cl-destructuring-bind (actual (removed added)) d\n                    (insert-label \"actual\")\n                    (insert-rect actual)\n                    (insert-label \"diff\")\n                    (insert \"- \")\n                    (insert-rect removed)\n                    (insert-align-label \"+ \")\n                    (insert-rect added)\n                    (insert \"\\n\")))\n              (when actual\n                (insert-label \"actual\")\n                (insert-rect actual)))\n            (when error\n              (insert-label \"error\")\n              (insert-text-button error\n                                  'follow-link t\n                                  'action '(lambda (_button) (cider-test-stacktrace))\n                                  'help-echo \"View causes and stacktrace\")\n              (insert \"\\n\"))\n            (when gen-input\n              (insert-label \"input\")\n              (insert (cider-font-lock-as-clojure gen-input)))\n            (overlay-put (make-overlay beg (point)) 'font-lock-face bg))\n          (insert \"\\n\"))))))\n\n(defun cider-test-non-passing (tests)\n  \"For a list of TESTS, each an `nrepl-dict`, return only those that did not pass.\"\n  (seq-filter (lambda (test)\n                (unless (equal (nrepl-dict-get test \"type\") \"pass\")\n                  test))\n              tests))\n\n(defun cider-test-render-report (buffer summary results)\n  \"Emit into BUFFER the report for the SUMMARY, and test RESULTS.\"\n  (with-current-buffer buffer\n    (let ((inhibit-read-only t))\n      (cider-test-report-mode)\n      (cider-insert \"Test Summary\" 'bold t)\n      (dolist (ns (nrepl-dict-keys results))\n        (insert (cider-propertize ns 'ns) \"\\n\"))\n      (cider-insert \"\\n\")\n      (cider-test-render-summary buffer summary)\n      (nrepl-dbind-response summary (fail error)\n        (unless (zerop (+ fail error))\n          (cider-insert \"Results\" 'bold t \"\\n\")\n          ;; Results are a nested dict, keyed first by ns, then var. Within each\n          ;; var is a sequence of test assertion results.\n          (nrepl-dict-map\n           (lambda (ns vars)\n             (nrepl-dict-map\n              (lambda (_var tests)\n                (let* ((problems (cider-test-non-passing tests))\n                       (count (length problems)))\n                  (when (< 0 count)\n                    (insert (format \"%s\\n%d non-passing tests:\\n\\n\"\n                                    (cider-propertize ns 'ns) count))\n                    (dolist (test problems)\n                      (cider-test-render-assertion buffer test)))))\n              vars))\n           results)))\n      (goto-char (point-min))\n      (current-buffer))))\n\n\n;;; Message echo\n\n(defun cider-test-echo-running (ns &optional test)\n  \"Echo a running message for the test NS, which may be a keyword.\nThe optional arg TEST denotes an individual test name.\"\n  (if test\n      (message \"Running test %s in %s...\"\n               (cider-propertize test 'bold)\n               (cider-propertize ns 'ns))\n    (message \"Running tests in %s...\"\n             (concat (cider-propertize\n                      (cond ((stringp ns) ns)\n                            ((eq :non-passing ns) \"failing\")\n                            ((eq :loaded ns)  \"all loaded\")\n                            ((eq :project ns) \"all project\"))\n                      'ns)\n                     (unless (stringp ns) \" namespaces\")))))\n\n(defun cider-test-echo-summary (summary results)\n  \"Echo SUMMARY statistics for a test run returning RESULTS.\"\n  (nrepl-dbind-response summary (ns test var fail error)\n    (if (nrepl-dict-empty-p results)\n        (message (concat (propertize \"No assertions (or no tests) were run.\" 'face 'cider-test-error-face)\n                         \"Did you forget to use `is' in your tests?\"))\n      (message (propertize\n                \"%sRan %d assertions, in %d test functions. %d failures, %d errors.\"\n                'face (cond ((not (zerop error)) 'cider-test-error-face)\n                            ((not (zerop fail))  'cider-test-failure-face)\n                            (t                   'cider-test-success-face)))\n               (concat (if (= 1 ns)     ; ns count from summary\n                           (cider-propertize (car (nrepl-dict-keys results)) 'ns)\n                         (propertize (format \"%d namespaces\" ns) 'face 'default))\n                       (propertize \": \" 'face 'default))\n               test var fail error))))\n\n;;; Test definition highlighting\n;;\n;; On receipt of test results, failing/erring test definitions are highlighted.\n;; Highlights are cleared on the next report run, and may be cleared manually\n;; by the user.\n\n;; NOTE If keybindings specific to test sources are desired, it would be\n;; straightforward to turn this into a `cider-test-mode' minor mode, which we\n;; enable on test sources, much like the legacy `clojure-test-mode'. At present,\n;; though, there doesn't seem to be much value in this, since the report buffer\n;; provides the primary means of interacting with test results.\n\n(defun cider-test-highlight-problem (buffer test)\n  \"Highlight the BUFFER test definition for the non-passing TEST.\"\n  (with-current-buffer buffer\n    ;; we don't need the file name here, as we always operate on the current\n    ;; buffer and the line data is correct even for vars that were\n    ;; defined interactively\n    (nrepl-dbind-response test (type line message expected actual)\n      (when line\n        (save-excursion\n          (goto-char (point-min))\n          (forward-line (1- line))\n          (search-forward \"(\" nil t)\n          (let ((beg (point)))\n            (forward-sexp)\n            (cider--make-overlay beg (point) 'cider-test\n                                 'font-lock-face (cider-test-type-face type)\n                                 'type type\n                                 'help-echo message\n                                 'message message\n                                 'expected expected\n                                 'actual actual)))))))\n\n(defun cider-find-var-file (ns var)\n  \"Return the buffer visiting the file in which the NS VAR is defined.\nOr nil if not found.\"\n  (when-let* ((info (cider-var-info (concat ns \"/\" var)))\n              (file (nrepl-dict-get info \"file\")))\n    (cider-find-file file)))\n\n(defun cider-test-highlight-problems (results)\n  \"Highlight all non-passing tests in the test RESULTS.\"\n  (nrepl-dict-map\n   (lambda (ns vars)\n     (nrepl-dict-map\n      (lambda (var tests)\n        (when-let* ((buffer (cider-find-var-file ns var)))\n          (dolist (test tests)\n            (nrepl-dbind-response test (type)\n              (unless (equal \"pass\" type)\n                (cider-test-highlight-problem buffer test))))))\n      vars))\n   results))\n\n(defun cider-test-clear-highlights ()\n  \"Clear highlighting of non-passing tests from the last test run.\"\n  (interactive)\n  (when cider-test-last-results\n    (nrepl-dict-map\n     (lambda (ns vars)\n       (dolist (var (nrepl-dict-keys vars))\n         (when-let* ((buffer (cider-find-var-file ns var)))\n           (with-current-buffer buffer\n             (remove-overlays nil nil 'category 'cider-test)))))\n     cider-test-last-results)))\n\n\n;;; Test namespaces\n;;\n;; Test namespace inference exists to enable DWIM test running functions: the\n;; same \"run-tests\" function should be able to be used in a source file, and in\n;; its corresponding test namespace. To provide this, we need to map the\n;; relationship between those namespaces.\n\n(defcustom cider-test-infer-test-ns 'cider-test-default-test-ns-fn\n  \"Function to infer the test namespace for NS.\nThe default implementation uses the simple Leiningen convention of appending\n'-test' to the namespace name.\"\n  :type 'symbol\n  :package-version '(cider . \"0.7.0\"))\n\n(defun cider-test-default-test-ns-fn (ns)\n  \"For a NS, return the test namespace, which may be the argument itself.\nThis uses the Leiningen convention of appending '-test' to the namespace name.\"\n  (when ns\n    (let ((suffix \"-test\"))\n      (if (string-suffix-p suffix ns)\n          ns\n        (concat ns suffix)))))\n\n\n;;; Test execution\n\n(defcustom cider-test-default-include-selectors '()\n  \"List of include selector strings to use when executing tests if none provided.\"\n  :type '(repeat string)\n  :package-version '(cider . \"1.1.0\"))\n\n(defcustom cider-test-default-exclude-selectors '()\n  \"List of exclude selector strings to use when executing tests if none provided.\"\n  :type '(repeat string)\n  :package-version '(cider . \"1.1.0\"))\n\n(declare-function cider-emit-interactive-eval-output \"cider-eval\")\n(declare-function cider-emit-interactive-eval-err-output \"cider-eval\")\n\n(defun cider-test--prompt-for-selectors (message)\n  \"Prompt for test selectors with MESSAGE.\nThe selectors can be either keywords or strings.\"\n  (mapcar\n   (lambda (string) (replace-regexp-in-string \"^:+\" \"\" string))\n   (split-string\n    (cider-read-from-minibuffer message))))\n\n(defun cider-test-execute (ns &optional tests silent prompt-for-filters)\n  \"Run tests for NS, which may be a keyword, optionally specifying TESTS.\nThis tests a single NS, or multiple namespaces when using keywords `:project',\n`:loaded' or `:non-passing'.  Optional TESTS are only honored when a single\nnamespace is specified.  Upon test completion, results are echoed and a test\nreport is optionally displayed.  When test failures/errors occur, their sources\nare highlighted.\nIf SILENT is non-nil, suppress all messages other then test results.\nIf PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selector filters.\nThe include/exclude selectors will be used to filter the tests before\nrunning them.\"\n  (cider-test-clear-highlights)\n  (let ((include-selectors\n         (if prompt-for-filters\n             (cider-test--prompt-for-selectors\n              \"Test selectors to include (space separated): \")\n           cider-test-default-include-selectors))\n        (exclude-selectors\n         (if prompt-for-filters\n             (cider-test--prompt-for-selectors\n              \"Test selectors to exclude (space separated): \")\n           cider-test-default-exclude-selectors)))\n    (cider-map-repls :clj-strict\n      (lambda (conn)\n        (unless silent\n          (if (and tests (= (length tests) 1))\n              ;; we generate a different message when running individual tests\n              (cider-test-echo-running ns (car tests))\n            (cider-test-echo-running ns)))\n        (let ((request `(\"op\" ,(cond ((stringp ns)         \"test\")\n                                     ((eq :project ns)     \"test-all\")\n                                     ((eq :loaded ns)      \"test-all\")\n                                     ((eq :non-passing ns) \"retest\")))))\n          ;; we add optional parts of the request only when relevant\n          (when (and (listp include-selectors) include-selectors)\n            (setq request (append request `(\"include\" ,include-selectors))))\n          (when (and (listp exclude-selectors) exclude-selectors)\n            (setq request (append request `(\"exclude\" ,exclude-selectors))))\n          (when (stringp ns)\n            (setq request (append request `(\"ns\" ,ns))))\n          (when (stringp ns)\n            (setq request (append request `(\"tests\" ,tests))))\n          (when (or (stringp ns) (eq :project ns))\n            (setq request (append request `(\"load?\" ,\"true\"))))\n          (cider-nrepl-send-request\n           request\n           (lambda (response)\n             (nrepl-dbind-response response (summary results status out err)\n               (cond ((member \"namespace-not-found\" status)\n                      (unless silent\n                        (message \"No test namespace: %s\" (cider-propertize ns 'ns))))\n                     (out (cider-emit-interactive-eval-output out))\n                     (err (cider-emit-interactive-eval-err-output err))\n                     (results\n                      (nrepl-dbind-response summary (error fail)\n                        (setq cider-test-last-summary summary)\n                        (setq cider-test-last-results results)\n                        (cider-test-highlight-problems results)\n                        (cider-test-echo-summary summary results)\n                        (if (or (not (zerop (+ error fail)))\n                                cider-test-show-report-on-success)\n                            (cider-test-render-report\n                             (cider-popup-buffer\n                              cider-test-report-buffer\n                              cider-auto-select-test-report-buffer)\n                             summary\n                             results)\n                          (when (get-buffer cider-test-report-buffer)\n                            (with-current-buffer cider-test-report-buffer\n                              (let ((inhibit-read-only t))\n                                (erase-buffer)))\n                            (cider-test-render-report\n                             cider-test-report-buffer\n                             summary results))))))))\n           conn))))))\n\n(defun cider-test-rerun-failed-tests ()\n  \"Rerun failed and erring tests from the last test run.\"\n  (interactive)\n  (if cider-test-last-summary\n      (nrepl-dbind-response cider-test-last-summary (fail error)\n        (if (not (zerop (+ error fail)))\n            (cider-test-execute :non-passing)\n          (message \"No prior failures to retest\")))\n    (message \"No prior results to retest\")))\n\n(defun cider-test-run-loaded-tests (prompt-for-filters)\n  \"Run all tests defined in currently loaded namespaces.\n\nIf PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to\nfilter the tests with.\"\n  (interactive \"P\")\n  (cider-test-execute :loaded nil nil prompt-for-filters))\n\n(defun cider-test-run-project-tests (prompt-for-filters)\n  \"Run all tests defined in all project namespaces, loading these as needed.\n\nIf PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to\nfilter the tests with.\"\n  (interactive \"P\")\n  (cider-test-execute :project nil nil prompt-for-filters))\n\n(defun cider-test-run-ns-tests-with-filters (suppress-inference)\n  \"Run tests filtered by selectors for the current Clojure namespace context.\n\nWith a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the\ncurrent ns.\"\n  (interactive \"P\")\n  (cider-test-run-ns-tests suppress-inference nil 't))\n\n(defun cider-test-run-ns-tests (suppress-inference &optional silent prompt-for-filters)\n  \"Run all tests for the current Clojure namespace context.\n\nIf SILENT is non-nil, suppress all messages other then test results.\nWith a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the\ncurrent ns.  If PROMPT-FOR-FILTERS is non-nil, prompt the user for\ntest selectors to filter the tests with.\"\n  (interactive \"P\")\n  (if-let* ((ns (if suppress-inference\n                    (cider-current-ns t)\n                  (funcall cider-test-infer-test-ns (cider-current-ns t)))))\n      (cider-test-execute ns nil silent prompt-for-filters)\n    (if (eq major-mode 'cider-test-report-mode)\n        (when (y-or-n-p (concat \"Test report does not define a namespace. \"\n                                \"Rerun failed/erring tests?\"))\n          (cider-test-rerun-failed-tests))\n      (unless silent\n        (message \"No namespace to test in current context\")))))\n\n(defvar cider-test-last-test-ns nil\n  \"The ns of the last test ran with `cider-test-run-test'.\")\n(defvar cider-test-last-test-var nil\n  \"The var of the last test ran with `cider-test-run-test'.\")\n\n(defun cider-test-update-last-test (ns var)\n  \"Update the last test by setting NS and VAR.\n\nSee `cider-test-rerun-test'.\"\n  (setq cider-test-last-test-ns ns\n        cider-test-last-test-var var))\n\n(defun cider-test-run-test ()\n  \"Run the test at point.\nThe test ns/var exist as text properties on report items and on highlighted\nfailed/erred test definitions.  When not found, a test definition at point\nis searched.\"\n  (interactive)\n  (let ((ns  (get-text-property (point) 'ns))\n        (var (get-text-property (point) 'var)))\n    (if (and ns var)\n        ;; we're in a `cider-test-report-mode' buffer\n        ;; or on a highlighted failed/erred test definition\n        (progn\n          (cider-test-update-last-test ns var)\n          (cider-test-execute ns (list var)))\n      ;; we're in a `clojure-mode' buffer\n      (let* ((ns  (clojure-find-ns))\n             (def (clojure-find-def)) ; it's a list of the form (deftest something)\n             (deftype (car def))\n             (var (cadr def)))\n        (if (and ns (member deftype cider-test-defining-forms))\n            (progn\n              (cider-test-update-last-test ns (list var))\n              (cider-test-execute ns (list var)))\n          (message \"No test at point\"))))))\n\n(defun cider-test-rerun-test ()\n  \"Re-run the test that was previously ran.\"\n  (interactive)\n  (if (and cider-test-last-test-ns cider-test-last-test-var)\n      (cider-test-execute cider-test-last-test-ns cider-test-last-test-var)\n    (user-error \"No test to re-run\")))\n\n;;; Auto-test mode\n(defun cider--test-silently ()\n  \"Like `cider-test-run-tests', but with less feedback.\nOnly notify the user if there actually were any tests to run and only after\nthe results are received.\"\n  (when (cider-connected-p)\n    (let ((cider-auto-select-test-report-buffer nil)\n          (cider-test-show-report-on-success nil))\n      (cider-test-run-ns-tests nil 'soft))))\n\n;;;###autoload\n(define-minor-mode cider-auto-test-mode\n  \"Toggle automatic testing of Clojure files.\n\nWhen enabled this reruns tests every time a Clojure file is loaded.\nOnly runs tests corresponding to the loaded file's namespace and does\nnothing if no tests are defined or if the file failed to load.\"\n  :init-value nil :lighter (cider-mode \" Test\") :keymap nil\n  :global t\n  (if cider-auto-test-mode\n      (add-hook 'cider-file-loaded-hook #'cider--test-silently)\n    (remove-hook 'cider-file-loaded-hook #'cider--test-silently)))\n\n(provide 'cider-test)\n\n;;; cider-test.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-tracing.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52903062,"end":52903102},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52903102},"to":{"change":3,"start":52899414,"end":52899414},"introduced_by":3}],"inode":{"change":3,"pos":52899414}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52899414},"to":{"change":3,"start":52899415,"end":52903061},"introduced_by":3}],"inode":{"change":3,"pos":52899414}},"content":[{"Del":";;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*-\n\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \n;;         Artur Malabarba \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; A couple of commands for tracing the execution of functions.\n\n;;; Code:\n\n(require 'cider-client)\n(require 'cider-common) ; for `cider-prompt-for-symbol-function'\n(require 'cider-util) ; for `cider-propertize'\n(require 'cider-connection) ; for `cider-map-repls'\n(require 'nrepl-dict)\n\n(defun cider-sync-request:toggle-trace-var (sym)\n  \"Toggle var tracing for SYM.\"\n  (thread-first `(\"op\" \"toggle-trace-var\"\n                  \"ns\" ,(cider-current-ns)\n                  \"sym\" ,sym)\n                (cider-nrepl-send-sync-request)))\n\n(defun cider--toggle-trace-var (sym)\n  \"Toggle var tracing for SYM.\"\n  (let* ((trace-response (cider-sync-request:toggle-trace-var sym))\n         (var-name (nrepl-dict-get trace-response \"var-name\"))\n         (var-status (nrepl-dict-get trace-response \"var-status\")))\n    (pcase var-status\n      (\"not-found\" (error \"Var %s not found\" (cider-propertize sym 'fn)))\n      (\"not-traceable\" (error \"Var %s can't be traced because it's not bound to a function\" (cider-propertize var-name 'fn)))\n      (_ (message \"Var %s %s\" (cider-propertize var-name 'fn) var-status)))))\n\n;;;###autoload\n(defun cider-toggle-trace-var (arg)\n  \"Toggle var tracing.\nPrompts for the symbol to use, or uses the symbol at point, depending on\nthe value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the\nopposite of what that option dictates.\"\n  (interactive \"P\")\n  (cider-ensure-op-supported \"toggle-trace-var\")\n  (funcall (cider-prompt-for-symbol-function arg)\n           \"Toggle trace for var\"\n           #'cider--toggle-trace-var))\n\n(defun cider-sync-request:toggle-trace-ns (ns)\n  \"Toggle namespace tracing for NS.\"\n  (thread-first `(\"op\" \"toggle-trace-ns\"\n                  \"ns\" ,ns)\n                (cider-nrepl-send-sync-request)))\n\n;;;###autoload\n(defun cider-toggle-trace-ns (query)\n  \"Toggle ns tracing.\nDefaults to the current ns.  With prefix arg QUERY, prompts for a ns.\"\n  (interactive \"P\")\n  (cider-map-repls :clj-strict\n    (lambda (conn)\n      (with-current-buffer conn\n        (cider-ensure-op-supported \"toggle-trace-ns\")\n        (let ((ns (if query\n                      (completing-read \"Toggle trace for ns: \"\n                                       (cider-sync-request:ns-list))\n                    (cider-current-ns))))\n          (let* ((trace-response (cider-sync-request:toggle-trace-ns ns))\n                 (ns-status (nrepl-dict-get trace-response \"ns-status\")))\n            (pcase ns-status\n              (\"not-found\" (error \"Namespace %s not found\" (cider-propertize ns 'ns)))\n              (_ (message \"Namespace %s %s\" (cider-propertize ns 'ns) ns-status)))))))))\n\n(provide 'cider-tracing)\n;;; cider-tracing.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-util.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52899375,"end":52899412},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52899412},"to":{"change":3,"start":52865081,"end":52865081},"introduced_by":3}],"inode":{"change":3,"pos":52865081}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52865081},"to":{"change":3,"start":52865082,"end":52899374},"introduced_by":3}],"inode":{"change":3,"pos":52865081}},"content":[{"Del":";; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Common utility functions that don't belong anywhere else.\n\n;;; Code:\n\n;; Built-ins\n(require 'ansi-color)\n(require 'color)\n(require 'seq)\n(require 'subr-x)\n(require 'thingatpt)\n\n;; clojure-mode and CIDER\n(require 'clojure-mode)\n\n(defalias 'cider-pop-back #'pop-tag-mark)\n\n(defcustom cider-font-lock-max-length 10000\n  \"The max length of strings to fontify in `cider-font-lock-as'.\n\nSetting this to nil removes the fontification restriction.\"\n  :group 'cider\n  :type 'boolean\n  :package-version '(cider . \"0.10.0\"))\n\n(defun cider-util--hash-keys (hashtable)\n  \"Return a list of keys in HASHTABLE.\"\n  (let ((keys '()))\n    (maphash (lambda (k _v) (setq keys (cons k keys))) hashtable)\n    keys))\n\n(defun cider-util--clojure-buffers ()\n  \"Return a list of all existing `clojure-mode' buffers.\"\n  (seq-filter\n   (lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode)))\n   (buffer-list)))\n\n(defun cider-current-dir ()\n  \"Return the directory of the current buffer.\"\n  (if buffer-file-name\n      (file-name-directory buffer-file-name)\n    default-directory))\n\n(defun cider-in-string-p ()\n  \"Return non-nil if point is in a string.\"\n  (let ((beg (save-excursion (beginning-of-defun) (point))))\n    (nth 3 (parse-partial-sexp beg (point)))))\n\n(defun cider-in-comment-p ()\n  \"Return non-nil if point is in a comment.\"\n  (let ((beg (save-excursion (beginning-of-defun) (point))))\n    (nth 4 (parse-partial-sexp beg (point)))))\n\n(defun cider--tooling-file-p (file-name)\n  \"Return t if FILE-NAME is not a 'real' source file.\nCurrently, only check if the relative file name starts with 'form-init'\nwhich nREPL uses for temporary evaluation file names.\"\n  (let ((fname (file-name-nondirectory file-name)))\n    (string-match-p \"^form-init\" fname)))\n\n(defun cider--cljc-buffer-p (&optional buffer)\n  \"Return non-nil if the current buffer is visiting a cljc file.\n\nIf BUFFER is provided act on that buffer instead.\"\n  (with-current-buffer (or buffer (current-buffer))\n    (or (derived-mode-p 'clojurec-mode))))\n\n\f\n;;; Thing at point\n\n(defun cider--text-or-limits (bounds start end)\n  \"Returns the substring or the bounds of text.\nIf BOUNDS is non-nil, returns the list (START END) of character\npositions.  Else returns the substring from START to END.\"\n  (funcall (if bounds #'list #'buffer-substring-no-properties)\n           start end))\n\n(defun cider-defun-at-point (&optional bounds)\n  \"Return the text of the top level sexp at point.\nIf BOUNDS is non-nil, return a list of its starting and ending position\ninstead.\"\n  (save-excursion\n    (save-match-data\n      (end-of-defun)\n      (let ((end (point)))\n        (clojure-backward-logical-sexp 1)\n        (cider--text-or-limits bounds (point) end)))))\n\n(defun cider-ns-form ()\n  \"Retrieve the ns form.\"\n  (when (clojure-find-ns)\n    (save-excursion\n      (goto-char (match-beginning 0))\n      (cider-defun-at-point))))\n\n(defun cider-symbol-at-point (&optional look-back)\n  \"Return the name of the symbol at point, otherwise nil.\nIgnores the REPL prompt.  If LOOK-BACK is non-nil, move backwards trying to\nfind a symbol if there isn't one at point.\nDoes not strip the : from keywords, nor attempt to expand :: auto-resolved\nkeywords.\"\n  (or (when-let* ((str (thing-at-point 'symbol)))\n        (unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str)\n          ;; remove font-locking\n          (setq str (substring-no-properties str))\n          (if (member str '(\".\" \"..\"))\n              str\n            ;; Remove prefix quotes, and trailing . from constructors like Record.\n            (thread-last\n              str\n              ;; constructors (Foo.)\n              (string-remove-suffix \".\")\n              ;; quoted symbols ('sym)\n              (string-remove-prefix \"'\")\n              ;; var references (#'inc 2)\n              (string-remove-prefix \"#'\")))))\n      (when look-back\n        (save-excursion\n          (ignore-errors\n            (when (looking-at \"(\")\n              (forward-char 1))\n            (while (not (looking-at \"\\\\sw\\\\|\\\\s_\\\\|\\\\`\"))\n              (forward-sexp -1)))\n          (cider-symbol-at-point)))))\n\n\f\n;;; sexp navigation\n(defun cider-sexp-at-point (&optional bounds)\n  \"Return the sexp at point as a string, otherwise nil.\nIf BOUNDS is non-nil, return a list of its starting and ending position\ninstead.\"\n  (when-let* ((b (or (and (equal (char-after) ?\\()\n                          (member (char-before) '(?\\' ?\\, ?\\@))\n                          ;; hide stuff before ( to avoid quirks with '( etc.\n                          (save-restriction\n                            (narrow-to-region (point) (point-max))\n                            (bounds-of-thing-at-point 'sexp)))\n                     (bounds-of-thing-at-point 'sexp))))\n    (funcall (if bounds #'list #'buffer-substring-no-properties)\n             (car b) (cdr b))))\n\n(defun cider-list-at-point (&optional bounds)\n  \"Return the list (compound form) at point as a string, otherwise nil.\nIf BOUNDS is non-nil, return a list of its starting and ending position\ninstead.\"\n  (when-let* ((b (or (and (equal (char-after) ?\\()\n                          (member (char-before) '(?\\' ?\\, ?\\@))\n                          ;; hide stuff before ( to avoid quirks with '( etc.\n                          (save-restriction\n                            (narrow-to-region (point) (point-max))\n                            (bounds-of-thing-at-point 'list)))\n                     (bounds-of-thing-at-point 'list))))\n    (funcall (if bounds #'list #'buffer-substring-no-properties)\n             (car b) (cdr b))))\n\n(defun cider-last-sexp (&optional bounds)\n  \"Return the sexp preceding the point.\nIf BOUNDS is non-nil, return a list of its starting and ending position\ninstead.\"\n  (apply (if bounds #'list #'buffer-substring-no-properties)\n         (save-excursion\n           (clojure-backward-logical-sexp 1)\n           (list (point)\n                 (progn (clojure-forward-logical-sexp 1)\n                        (point))))))\n\n(defun cider-start-of-next-sexp (&optional skip)\n  \"Move to the start of the next sexp.\nSkip any non-logical sexps like ^metadata or #reader macros.\nIf SKIP is an integer, also skip that many logical sexps first.\nCan only error if SKIP is non-nil.\"\n  (while (clojure--looking-at-non-logical-sexp)\n    (forward-sexp 1))\n  (when (and skip (> skip 0))\n    (dotimes (_ skip)\n      (forward-sexp 1)\n      (cider-start-of-next-sexp))))\n\n(defun cider-second-sexp-in-list ()\n  \"Return the second sexp in the list at point.\"\n  (condition-case nil\n      (save-excursion\n        (backward-up-list)\n        (forward-char)\n        (forward-sexp 2)\n        (cider-sexp-at-point))\n    (error nil)))\n\f\n;;; Text properties\n\n(defun cider-maybe-intern (name)\n  \"If NAME is a symbol, return it; otherwise, intern it.\"\n  (if (symbolp name) name (intern name)))\n\n(defun cider-intern-keys (plist)\n  \"Copy PLIST, with any non-symbol keys replaced with symbols.\"\n  (when plist\n    (cons (cider-maybe-intern (pop plist))\n          (cons (pop plist) (cider-intern-keys plist)))))\n\n(defmacro cider-propertize-region (props &rest body)\n  \"Execute BODY and add PROPS to all the inserted text.\nMore precisely, PROPS are added to the region between the point's\npositions before and after executing BODY.\"\n  (declare (indent 1)\n           (debug (sexp body)))\n  (let ((start (make-symbol \"start\")))\n    `(let ((,start (point)))\n       (prog1 (progn ,@body)\n         (add-text-properties ,start (point) ,props)))))\n\n(put 'cider-propertize-region 'lisp-indent-function 1)\n\n(defun cider-property-bounds (prop)\n  \"Return the the positions of the previous and next change to PROP.\nPROP is the name of a text property.\"\n  (let ((end (next-single-char-property-change (point) prop)))\n    (list (previous-single-char-property-change end prop) end)))\n\n(defun cider-insert (text &optional face break more-text)\n  \"Insert TEXT with FACE, optionally followed by a line BREAK and MORE-TEXT.\"\n  (insert (if face (propertize text 'font-lock-face face) text))\n  (when more-text (insert more-text))\n  (when break (insert \"\\n\")))\n\n\f\n;;; Hooks\n\n(defun cider-run-chained-hook (hook arg)\n  \"Like `run-hook-with-args' but pass intermediate return values through.\nHOOK is a name of a hook (a symbol).  You can use `add-hook' or\n`remove-hook' to add functions to this variable.  ARG is passed to first\nfunction.  Its return value is passed to the second function and so forth\ntill all functions are called or one of them returns nil.  Return the value\nreturn by the last called function.\"\n  (let ((functions (copy-sequence (symbol-value hook))))\n    (while (and functions arg)\n      (if (eq (car functions) t)\n          ;; global value of the hook\n          (let ((functions (default-value hook)))\n            (while (and functions arg)\n              (setq arg (funcall (car functions) arg))\n              (setq functions (cdr functions))))\n        (setq arg (funcall (car functions) arg)))\n      (setq functions (cdr functions)))\n    arg))\n\n\f\n;;; Font lock\n\n(defvar cider--mode-buffers nil\n  \"A list of buffers for different major modes.\")\n\n(defun cider--make-buffer-for-mode (mode)\n  \"Return a temp buffer using `major-mode' MODE.\nThis buffer is not designed to display anything to the user.  For that, use\n`cider-make-popup-buffer' instead.\"\n  (setq cider--mode-buffers (seq-filter (lambda (x) (buffer-live-p (cdr x)))\n                                        cider--mode-buffers))\n  (or (cdr (assq mode cider--mode-buffers))\n      (let ((b (generate-new-buffer (format \" *cider-temp %s*\" mode))))\n        (push (cons mode b) cider--mode-buffers)\n        (with-current-buffer b\n          ;; suppress major mode hooks as we care only about their font-locking\n          ;; otherwise modes like whitespace-mode and paredit might interfere\n          (setq-local delay-mode-hooks t)\n          (setq delayed-mode-hooks nil)\n          (funcall mode))\n        b)))\n\n(defun cider-ansi-color-string-p (string)\n  \"Return non-nil if STRING is an ANSI string.\"\n  (string-match \"^\u001b\\\\[\" string))\n\n(defun cider-font-lock-as (mode string)\n  \"Use MODE to font-lock the STRING.\"\n  (let ((string (if (cider-ansi-color-string-p string)\n                    (substring-no-properties (ansi-color-apply string))\n                  string)))\n    (if (or (null cider-font-lock-max-length)\n            (< (length string) cider-font-lock-max-length))\n        (with-current-buffer (cider--make-buffer-for-mode mode)\n          (erase-buffer)\n          (insert string)\n          ;; don't try to font-lock unbalanced Clojure code\n          (when (eq mode 'clojure-mode)\n            (check-parens))\n          (font-lock-fontify-region (point-min) (point-max))\n          (buffer-string))\n      string)))\n\n(defun cider-font-lock-region-as (mode beg end &optional buffer)\n  \"Use MODE to font-lock text between BEG and END.\n\nUnless you specify a BUFFER it will default to the current one.\"\n  (with-current-buffer (or buffer (current-buffer))\n    (let ((text (buffer-substring beg end)))\n      (delete-region beg end)\n      (goto-char beg)\n      (insert (cider-font-lock-as mode text)))))\n\n(defun cider-font-lock-as-clojure (string)\n  \"Font-lock STRING as Clojure code.\"\n  ;; If something goes wrong (e.g. the code is not balanced)\n  ;; we simply return the string.\n  (condition-case nil\n      (cider-font-lock-as 'clojure-mode string)\n    (error string)))\n\n;; Button allowing use of `font-lock-face', ignoring any inherited `face'\n(define-button-type 'cider-plain-button\n  'face nil)\n\n(defun cider-add-face (regexp face &optional foreground-only sub-expr object)\n  \"Propertize all occurrences of REGEXP with FACE.\nIf FOREGROUND-ONLY is non-nil, change only the foreground of matched\nregions.  SUB-EXPR is a sub-expression of REGEXP to be\npropertized (defaults to 0).  OBJECT is an object to be\npropertized (defaults to current buffer).\"\n  (setq sub-expr (or sub-expr 0))\n  (when (and regexp face)\n    (let ((beg 0)\n          (end 0))\n      (with-current-buffer (or (and (bufferp object) object)\n                               (current-buffer))\n        (while (if (stringp object)\n                   (string-match regexp object end)\n                 (re-search-forward regexp nil t))\n          (setq beg (match-beginning sub-expr)\n                end (match-end sub-expr))\n          (if foreground-only\n              (let ((face-spec (list (cons 'foreground-color\n                                           (face-attribute face :foreground nil t)))))\n                (font-lock-prepend-text-property beg end 'face face-spec object))\n            (put-text-property beg end 'face face object)))))))\n\n\f\n;;; Colors\n\n(defun cider-scale-background-color ()\n  \"Scale the current background color to get a slighted muted version.\"\n  (let ((color (frame-parameter nil 'background-color))\n        (darkp (eq (frame-parameter nil 'background-mode) 'dark)))\n    (unless (equal \"unspecified-bg\" color)\n      (color-lighten-name color (if darkp 5 -5)))))\n\n(defvar cider-version)\n(defvar cider-codename)\n\n(defun cider--pkg-version ()\n  \"Extract CIDER's package version from its package metadata.\"\n  ;; Use `cond' below to avoid a compiler unused return value warning\n  ;; when `package-get-version' returns nil. See #3181.\n  ;; FIXME: Inline the logic from package-get-version and adapt it\n  (cond ((fboundp 'package-get-version)\n         (package-get-version))))\n\n(defun cider--version ()\n  \"Retrieve CIDER's version.\nA codename is added to stable versions.\"\n  (if (string-match-p \"-snapshot\" cider-version)\n      (let ((pkg-version (cider--pkg-version)))\n        (if pkg-version\n            ;; snapshot versions include the MELPA package version\n            (format \"%s (package: %s)\" cider-version pkg-version)\n          cider-version))\n    ;; stable versions include the codename of the release\n    (format \"%s (%s)\" cider-version cider-codename)))\n\n\f\n;;; Strings\n\n(defun cider-join-into-alist (candidates &optional separator)\n  \"Make an alist from CANDIDATES.\nThe keys are the elements joined with SEPARATOR and values are the original\nelements.  Useful for `completing-read' when candidates are complex\nobjects.\"\n  (mapcar (lambda (el)\n            (if (listp el)\n                (cons (string-join el (or separator \":\")) el)\n              (cons el el)))\n          candidates))\n\n(defun cider-add-to-alist (symbol car cadr)\n  \"Add '(CAR CADR) to the alist stored in SYMBOL.\nIf CAR already corresponds to an entry in the alist, destructively replace\nthe entry's second element with CADR.\n\nThis can be used, for instance, to update the version of an injected\nplugin or dependency with:\n  (cider-add-to-alist 'cider-jack-in-lein-plugins\n                  \\\"plugin/artifact-name\\\" \\\"THE-NEW-VERSION\\\")\"\n  (let ((alist (symbol-value symbol)))\n    (if-let* ((cons (assoc car alist)))\n        (setcdr cons (list cadr))\n      (set symbol (cons (list car cadr) alist)))))\n\n(defun cider-namespace-qualified-p (sym)\n  \"Return t if SYM is namespace-qualified.\"\n  (string-match-p \"[^/]+/\" sym))\n\n(defvar cider-version)\n\n(defconst cider-manual-url \"https://docs.cider.mx/cider/%s\"\n  \"The URL to CIDER's manual.\")\n\n(defun cider-version-sans-patch ()\n  \"Return the version sans that patch.\"\n  (string-join (seq-take (split-string cider-version \"\\\\.\") 2) \".\"))\n\n(defun cider--manual-version ()\n  \"Convert the version to a ReadTheDocs-friendly version.\"\n  (if (string-match-p \"-snapshot\" cider-version)\n      \"\"\n    (concat (cider-version-sans-patch) \"/\")))\n\n(defun cider-manual-url ()\n  \"The CIDER manual's url.\"\n  (format cider-manual-url (cider--manual-version)))\n\n;;;###autoload\n(defun cider-view-manual ()\n  \"View the manual in your default browser.\"\n  (interactive)\n  (browse-url (cider-manual-url)))\n\n(defun cider--manual-button (label section-id)\n  \"Return a button string that links to the online manual.\nLABEL is the displayed string, and SECTION-ID is where it points\nto.\"\n  (with-temp-buffer\n    (insert-text-button\n     label\n     'follow-link t\n     'action (lambda (&rest _) (interactive)\n               (browse-url (concat (cider-manual-url)\n                                   section-id))))\n    (buffer-string)))\n\n(defconst cider-refcard-url \"https://github.com/clojure-emacs/cider/raw/%s/refcard/cider-refcard.pdf\"\n  \"The URL to CIDER's refcard.\")\n\n(defun cider--github-version ()\n  \"Convert the version to a GitHub-friendly version.\"\n  (if (string-match-p \"-snapshot\" cider-version)\n      \"master\"\n    (concat \"v\" cider-version)))\n\n(defun cider-refcard-url ()\n  \"The CIDER manual's url.\"\n  (format cider-refcard-url (cider--github-version)))\n\n(defun cider-view-refcard ()\n  \"View the refcard in your default browser.\"\n  (interactive)\n  (browse-url (cider-refcard-url)))\n\n(defconst cider-report-bug-url \"https://github.com/clojure-emacs/cider/issues/new\"\n  \"The URL to report a CIDER issue.\")\n\n(defun cider-report-bug ()\n  \"Report a bug in your default browser.\"\n  (interactive)\n  (browse-url cider-report-bug-url))\n\n(defun cider--project-name (dir)\n  \"Extracts a project name from DIR, possibly nil.\nThe project name is the final component of DIR if not nil.\"\n  (when dir\n    (file-name-nondirectory (directory-file-name dir))))\n\n;;; Vectors\n(defun cider--deep-vector-to-list (x)\n  \"Convert vectors in X to lists.\nIf X is a sequence, return a list of `cider--deep-vector-to-list' applied to\neach of its elements.\nAny other value is just returned.\"\n  (if (sequencep x)\n      (mapcar #'cider--deep-vector-to-list x)\n    x))\n\n\n;;; Help mode\n\n;; Same as https://github.com/emacs-mirror/emacs/blob/86d083438dba60dc00e9e96414bf7e832720c05a/lisp/help-mode.el#L355\n;; the original function uses some buffer local variables, but the buffer used\n;; is not configurable. It defaults to (help-buffer)\n\n(defun cider--help-setup-xref (item interactive-p buffer)\n  \"Invoked from commands using the \\\"*Help*\\\" buffer to install some xref info.\n\nITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help\nbuffer after following a reference.  INTERACTIVE-P is non-nil if the\ncalling command was invoked interactively.  In this case the stack of\nitems for help buffer \\\"back\\\" buttons is cleared.  Use BUFFER for the\nbuffer local variables.\n\nThis should be called very early, before the output buffer is cleared,\nbecause we want to record the \\\"previous\\\" position of point so we can\nrestore it properly when going back.\"\n  (with-current-buffer buffer\n    (when help-xref-stack-item\n      (push (cons (point) help-xref-stack-item) help-xref-stack)\n      (setq help-xref-forward-stack nil))\n    (when interactive-p\n      (let ((tail (nthcdr 10 help-xref-stack)))\n        ;; Truncate the stack.\n        (if tail (setcdr tail nil))))\n    (setq help-xref-stack-item item)))\n\n(defcustom cider-doc-xref-regexp\n  (eval-and-compile\n    (rx-to-string\n     `(or (: \"`\" (group-n 1 (+ (not space))) \"`\")  ; `var`\n          (: \"[[\" (group-n 1 (+ (not space))) \"]]\") ; [[var]]\n          (group-n 1 (regexp ,clojure--sym-regexp) \"/\" (regexp ,clojure--sym-regexp))))) ;; Fully qualified\n  \"The regexp used to search Clojure vars in doc buffers.\"\n  :type 'regexp\n  :safe #'stringp\n  :group 'cider\n  :package-version '(cider . \"0.13.0\"))\n\n(defun cider--find-symbol-xref ()\n  \"Parse and return the first clojure symbol in current buffer.\nUse `cider-doc-xref-regexp' for the search.  Set match data and return a\nstring of the Clojure symbol.  Return nil if there are no more matches in\nthe buffer.\"\n  (when (re-search-forward cider-doc-xref-regexp nil t)\n    (match-string 1)))\n\n(declare-function cider-doc-lookup \"cider-doc\")\n(declare-function cider--eldoc-remove-dot \"cider-eldoc\")\n\n;; Taken from: https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L551-L565\n(defun cider--make-back-forward-xrefs (&optional buffer)\n  \"Insert special references `back' and `forward', as in `help-make-xrefs'.\n\nOptional argument BUFFER is the buffer in which to insert references.\nDefault is current buffer.\"\n  (with-current-buffer (or buffer (current-buffer))\n    (insert \"\\n\")\n    (when (or help-xref-stack help-xref-forward-stack)\n      (insert \"\\n\"))\n    ;; Make a back-reference in this buffer if appropriate.\n    (when help-xref-stack\n      (help-insert-xref-button help-back-label 'help-back\n                               (current-buffer)))\n    ;; Make a forward-reference in this buffer if appropriate.\n    (when help-xref-forward-stack\n      (when help-xref-stack\n        (insert \"\\t\"))\n      (help-insert-xref-button help-forward-label 'help-forward\n                               (current-buffer)))\n    (when (or help-xref-stack help-xref-forward-stack)\n      (insert \"\\n\"))))\n\n;; Similar to https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L404\n(defun cider--doc-make-xrefs ()\n  \"Parse and hyperlink documentation cross-references in current buffer.\nFind cross-reference information in a buffer and activate such cross\nreferences for selection with `help-xref'.  Cross-references are parsed\nusing `cider--find-symbol-xref'.\n\nSpecial references `back' and `forward' are made to go back and forth\nthrough a stack of help buffers.  Variables `help-back-label' and\n`help-forward-label' specify the text for that.\"\n  (interactive \"b\")\n\n  ;; parse the docstring and create xrefs for symbols\n  (save-excursion\n    (goto-char (point-min))\n    (let ((symbol))\n      (while (setq symbol (cider--find-symbol-xref))\n        (replace-match \"\")\n        (insert-text-button symbol\n                            'type 'help-xref\n                            'help-function (apply-partially #'cider-doc-lookup\n                                                            (cider--eldoc-remove-dot symbol))))))\n  (cider--make-back-forward-xrefs))\n\n\f\n;;; Words of inspiration\n(defun cider-user-first-name ()\n  \"Find the current user's 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 cider-words-of-inspiration\n  `(\"The best way to predict the future is to invent it. -Alan Kay\"\n    \"A point of view is worth 80 IQ points. -Alan Kay\"\n    \"Lisp isn't a language, it's a building material. -Alan Kay\"\n    \"Simple things should be simple, complex things should be possible. -Alan Kay\"\n    \"Everything should be as simple as possible, but not simpler. -Albert Einstein\"\n    \"Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates\"\n    \"Controlling complexity is the essence of computer programming. -Brian Kernighan\"\n    \"The unavoidable price of reliability is simplicity. -C.A.R. Hoare\"\n    \"You're bound to be unhappy if you optimize everything. -Donald Knuth\"\n    \"Simplicity is prerequisite for reliability. -Edsger W. Dijkstra\"\n    \"Elegance is not a dispensable luxury but a quality that decides between success and failure. -Edsger W. Dijkstra\"\n    \"Deleted code is debugged code. -Jeff Sickel\"\n    \"The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy\"\n    \"First, solve the problem. Then, write the code. -John Johnson\"\n    \"Simplicity is the ultimate sophistication. -Leonardo da Vinci\"\n    \"Programming is not about typing... it's about thinking. -Rich Hickey\"\n    \"Design is about pulling things apart. -Rich Hickey\"\n    \"Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey\"\n    \"Code never lies, comments sometimes do. -Ron Jeffries\"\n    \"The true delight is in the finding out rather than in the knowing. -Isaac Asimov\"\n    \"If paredit is not for you, then you need to become the sort of person that paredit is for. -Phil Hagelberg\"\n    \"Express Yourself. -Madonna\"\n    \"Put on your red shoes and dance the blues. -David Bowie\"\n    \"Do. Or do not. There is no try. -Yoda\"\n    \"The enjoyment of one's tools is an essential ingredient of successful work. -Donald E. Knuth\"\n    \"Not all those who wander are lost. -J.R.R. Tolkien\"\n    \"The best way to learn is to do. -P.R. Halmos\"\n    \"If you wish to make an apple pie from scratch, you must first invent the universe. -Carl Sagan\"\n    \"Learn the rules like a pro, so you can break them like an artist. -Pablo Picasso\"\n    \"The only way of discovering the limits of the possible is to venture a little way past them into the impossible. -Arthur C. Clarke\"\n    \"Don't wish it were easier. Wish you were better. -Jim Rohn\"\n    \"One chord is fine. Two chords is pushing it. Three chords and you're into jazz. -Lou Reed\"\n    \"We are all apprentices in a craft where no one ever becomes a master. -Ernest Hemingway\"\n    \"A designer knows he has achieved perfection not when there is nothing left to add, but when there is nothing left to take away. -Antoine de Saint-Exupery\"\n    \"Clojure isn't a language, it's a building material.\"\n    \"Think big!\"\n    \"Think bold!\"\n    \"Think fun!\"\n    \"Code big!\"\n    \"Code bold!\"\n    \"Code fun!\"\n    \"Take this REPL, fellow hacker, and may it serve you well.\"\n    \"Let the hacking commence!\"\n    \"Hacks and glory await!\"\n    \"Hack and be merry!\"\n    \"Your hacking starts... NOW!\"\n    \"May the Source be with you!\"\n    \"May the Source shine upon thy REPL!\"\n    \"Code long and prosper!\"\n    \"Happy hacking!\"\n    \"nREPL server is up, CIDER REPL is online!\"\n    \"CIDER REPL operational!\"\n    \"Your imagination is the only limit to what you can do with this REPL!\"\n    \"This REPL is yours to command!\"\n    \"Fame is but a hack away!\"\n    \"The REPL is not enough, but it is such a perfect place to start...\"\n    \"Keep on codin' in the free world!\"\n    \"What we do in the REPL echoes in eternity!\"\n    \"Evaluating is believing.\"\n    \"To infinity... and beyond.\"\n    \"Showtime!\"\n    \"Unfortunately, no one can be told what CIDER is. You have to figure this out yourself.\"\n    \"Procure a bottle of cider to achieve optimum programming results.\"\n    \"In parentheses we trust!\"\n    \"Write you some Clojure for Great Good!\"\n    \"Oh, what a day... what a lovely day!\"\n    \"What a day! What cannot be accomplished on such a splendid day!\"\n    \"Home is where your REPL is.\"\n    \"The worst day programming is better than the best day working.\"\n    \"The only thing worse than a rebel without a cause is a REPL without a clause.\"\n    \"In the absence of parentheses, chaos prevails.\"\n    \"One REPL to rule them all, One REPL to find them, One REPL to bring them all, and in parentheses bind them!\"\n    \"A blank REPL promotes creativity.\"\n    \"A blank REPL is infinitely better than a blank cheque.\"\n    ,(format \"%s, I've a feeling we're not in Kansas anymore.\"\n             (cider-user-first-name))\n    ,(format \"%s, this could be the start of a beautiful program.\"\n             (cider-user-first-name)))\n  \"Scientifically-proven optimal words of hackerish encouragement.\")\n\n(defun cider-random-words-of-inspiration ()\n  \"Select a random entry from `cider-words-of-inspiration'.\"\n  (nth (random (length cider-words-of-inspiration))\n       cider-words-of-inspiration))\n\n(defun cider-inspire-me ()\n  \"Display a random inspiration message.\"\n  (interactive)\n  (message (cider-random-words-of-inspiration)))\n\n(defvar cider-tips\n  '(\"Press <\\\\[cider-connect]> to connect to a running nREPL server.\"\n    \"Press <\\\\[cider-quit]> to quit the current connection.\"\n    \"Press <\\\\[cider-view-manual]> to view CIDER's manual.\"\n    \"Press <\\\\[cider-view-refcard]> to view CIDER's refcard.\"\n    \"Press <\\\\[describe-mode]> to see a list of the keybindings available (this will work in every Emacs buffer).\"\n    \"Press <\\\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command.\"\n    \"Press <\\\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure source buffer.\"\n    \"Press <\\\\[cider-doc]> to view the documentation for something (e.g. a var, a Java method).\"\n    \"Press <\\\\[cider-find-resource]> to find a resource on the classpath.\"\n    \"Press <\\\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method).\"\n    \"Press <\\\\[cider-selector]> to quickly select a CIDER buffer.\"\n    \"Press <\\\\[cider-test-run-ns-tests]> to run the tests for the current namespace.\"\n    \"Press <\\\\[cider-test-run-loaded-tests]> to run all loaded tests.\"\n    \"Press <\\\\[cider-test-run-project-tests]> to run all tests for the current project.\"\n    \"Press <\\\\[cider-apropos]> to look for a symbol by some search string.\"\n    \"Press <\\\\[cider-apropos-documentation]> to look for a symbol that has some string in its docstring.\"\n    \"Press <\\\\[cider-eval-defun-at-point]> to eval the top-level form at point.\"\n    \"Press <\\\\[cider-eval-defun-up-to-point]> to eval the top-level form up to the point.\"\n    \"Press <\\\\[cider-eval-sexp-up-to-point]> to eval the current form up to the point.\"\n    \"Press <\\\\[cider-eval-sexp-at-point]> to eval the current form around the point.\"\n    \"Press <\\\\[cider-eval-sexp-at-point-in-context]> to eval the current form around the point in a user-provided context.\"\n    \"Press <\\\\[cider-eval-buffer]> to eval the entire source buffer.\"\n    \"Press <\\\\[cider-scratch]> to create a Clojure scratchpad. Pretty handy for prototyping.\"\n    \"Press <\\\\[cider-read-and-eval]> to evaluate some Clojure expression directly in the minibuffer.\"\n    \"Press <\\\\[cider-drink-a-sip]> to get more CIDER tips.\"\n    \"Press <\\\\[cider-browse-ns-all]> to start CIDER's namespace browser.\"\n    \"Press <\\\\[cider-classpath]> to start CIDER's classpath browser.\"\n    \"Press <\\\\[cider-repl-history]> to start CIDER's REPL input history browser.\"\n    \"Press <\\\\[cider-macroexpand-1]> to expand the preceding macro.\"\n    \"Press <\\\\[cider-inspect]> to inspect the preceding expression's result.\"\n    \"Press  to inspect the defun at point's result.\"\n    \"Press  to read Clojure code from the minibuffer and inspect its result.\"\n    \"Press <\\\\[cider-ns-refresh]> to reload modified and unloaded namespaces.\"\n    \"You can define Clojure functions to be called before and after `cider-ns-refresh' (see `cider-ns-refresh-before-fn' and `cider-ns-refresh-after-fn'.\"\n    \"Press <\\\\[cider-describe-connection]> to view information about the connection.\"\n    \"Press <\\\\[cider-undef]> to undefine a symbol in the current namespace.\"\n    \"Press <\\\\[cider-interrupt]> to interrupt an ongoing evaluation.\"\n    \"Use  to see every possible setting you can customize.\"\n    \"Use  to see every possible REPL setting you can customize.\"\n    \"Enable `eldoc-mode' to display function & method signatures in the minibuffer.\"\n    \"Enable `cider-enlighten-mode' to display the locals of a function when it's executed.\"\n    \"Use <\\\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*).\"\n    \"Exploring CIDER's menu-bar entries is a great way to discover features.\"\n    \"Keep in mind that some commands don't have a keybinding by default. Explore CIDER!\"\n    \"Tweak `cider-repl-prompt-function' to customize your REPL prompt.\"\n    \"Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc.\"\n    \"For no middleware, low-tech and reliable namespace reloading use <\\\\[cider-ns-reload]>.\"\n    \"Press <\\\\[cider-load-buffer-and-switch-to-repl-buffer]> to load the current buffer and switch to the REPL buffer afterwards.\")\n  \"Some handy CIDER tips.\"\n  )\n\n(defun cider-random-tip ()\n  \"Select a random tip from `cider-tips'.\"\n  (substitute-command-keys (nth (random (length cider-tips)) cider-tips)))\n\n(defun cider-drink-a-sip ()\n  \"Show a random tip.\"\n  (interactive)\n  (message (cider-random-tip)))\n\n(defun cider-column-number-at-pos (pos)\n  \"Analog to `line-number-at-pos'.\nReturn buffer column number at position POS.\"\n  (save-excursion\n    (goto-char pos)\n    ;; we have to adjust the column number by 1 to account for the fact\n    ;; that Emacs starts counting columns from 0 and Clojure from 1\n    (1+ (current-column))))\n\n(defun cider-propertize (text kind)\n  \"Propertize TEXT as KIND.\nKIND can be the symbols `ns', `var', `emph', `fn', or a face name.\"\n  (propertize text 'face (pcase kind\n                           (`fn 'font-lock-function-name-face)\n                           (`method 'font-lock-function-name-face)\n                           (`special-form 'font-lock-keyword-face)\n                           (`macro 'font-lock-keyword-face)\n                           (`var 'font-lock-variable-name-face)\n                           (`ns 'font-lock-type-face)\n                           (`emph 'font-lock-keyword-face)\n                           (face face))))\n\n(defun cider--menu-add-help-strings (menu-list)\n  \"Add a :help entries to items in MENU-LIST.\"\n  (mapcar (lambda (x)\n            (cond\n             ((listp x) (cider--menu-add-help-strings x))\n             ((and (vectorp x)\n                   (not (plist-get (append x nil) :help))\n                   (functionp (elt x 1)))\n              (vconcat x `[:help ,(documentation (elt x 1))]))\n             (t x)))\n          menu-list))\n\n(provide 'cider-util)\n\n;;; cider-util.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider-xref.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52865042,"end":52865079},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52865079},"to":{"change":3,"start":52857342,"end":52857342},"introduced_by":3}],"inode":{"change":3,"pos":52857342}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52857342},"to":{"change":3,"start":52857343,"end":52865041},"introduced_by":3}],"inode":{"change":3,"pos":52857342}},"content":[{"Del":";;; cider-xref.el --- Xref functionality for Clojure -*- lexical-binding: t -*-\n\n;; Copyright © 2019-2022 Bozhidar Batsov and CIDER contributors\n;;\n;; Author: Bozhidar Batsov \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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Xref (find usages) functionality for Clojure.  The implementation is based on\n;; ideas from this article https://metaredux.com/posts/2019/05/04/discovering-runtime-function-references-in-clojure.html.\n;;\n;; Keep in mind that you won't get references in namespaces that haven't been loaded yet.\n\n;;; Code:\n\n(require 'cider-doc)\n(require 'cider-find)\n(require 'cider-util)\n(require 'subr-x)\n\n(require 'cider-client)\n(require 'cider-popup)\n(require 'nrepl-dict)\n\n(require 'clojure-mode)\n(require 'apropos)\n(require 'button)\n\n(defconst cider-xref-buffer \"*cider-xref*\")\n\n(defcustom cider-xref-actions '((\"display-doc\" . cider-doc-lookup)\n                                (\"find-def\" . cider--find-var)\n                                (\"lookup-on-clojuredocs\" . cider-clojuredocs-lookup))\n  \"Controls the actions to be applied on the symbol found by an xref search.\nThe first action key in the list will be selected as default.  If the list\ncontains only one action key, the associated action function will be\napplied automatically.  An action function can be any function that receives\nthe symbol found by the xref search as argument.\"\n  :type '(alist :key-type string :value-type function)\n  :group 'cider\n  :package-version '(cider . \"0.22.0\"))\n\n(defun cider-xref-doc (button)\n  \"Display documentation for the symbol represented at BUTTON.\"\n  (cider-doc-lookup (button-get button 'apropos-symbol)))\n\n(defun cider-xref-result (result)\n  \"Emit a RESULT into current buffer.\"\n  (let ((var-name (nrepl-dict-get result \"name\")))\n    (cider-propertize-region (list 'apropos-symbol var-name\n                                   'action #'cider-xref-doc\n                                   'help-echo \"Display doc\")\n      (insert-text-button var-name 'type 'apropos-symbol))\n    (insert \"\\n  \")\n    (insert-text-button \"Function\" 'type 'apropos-function)\n    (insert \": \")\n    (let ((beg (point)))\n      (insert (nrepl-dict-get result \"doc\"))\n      (fill-region beg (point)))\n    (insert \"\\n\")\n    (if-let* ((file (nrepl-dict-get result \"file\"))\n              (line (nrepl-dict-get result \"line\")))\n        (progn\n          (insert (propertize var-name\n                              'font-lock-face 'font-lock-function-name-face)\n                  \" is defined in \")\n          (insert-text-button (cider--abbreviate-file-protocol file)\n                              'follow-link t\n                              'action (lambda (_x)\n                                        (cider-xref-source file line var-name)))\n          (insert \".\"))\n      (insert \"Definition location unavailable.\"))\n    (insert \"\\n\")))\n\n(defun cider-xref-source (file line name)\n  \"Find source for FILE, LINE and NAME.\"\n  (interactive)\n  (if file\n      (if-let* ((buffer (and (not (cider--tooling-file-p file))\n                             (cider-find-file file))))\n          (cider-jump-to buffer (if line\n                                    (cons line nil)\n                                  name)\n                         nil)\n        (user-error\n         (substitute-command-keys\n          \"Can't find the source because it wasn't defined with `cider-eval-buffer'\")))\n    (error \"No source location for %s\" name)))\n\n(declare-function cider-mode \"cider-mode\")\n\n(defun cider-show-xref (summary results)\n  \"Show SUMMARY and RESULTS in a pop-up buffer.\"\n  (with-current-buffer (cider-popup-buffer cider-xref-buffer 'select 'apropos-mode 'ancillary)\n    (let ((inhibit-read-only t))\n      (if (boundp 'header-line-format)\n          (setq-local header-line-format summary)\n        (insert summary \"\\n\\n\"))\n      (dolist (result results)\n        (cider-xref-result result))\n      (goto-char (point-min)))))\n\n;;;###autoload\n(defun cider-xref-fn-refs (&optional ns symbol)\n  \"Show all functions that reference the var matching NS and SYMBOL.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"fn-refs\")\n  (if-let* ((ns (or ns (cider-current-ns)))\n            (symbol (or symbol (cider-symbol-at-point)))\n            (results (cider-sync-request:fn-refs ns symbol)))\n      (cider-show-xref (format \"Showing %d functions that reference %s in currently loaded namespaces\" (length results) symbol) results)\n    (message \"No references found for %S in currently loaded namespaces\" symbol)))\n\n;;;###autoload\n(defun cider-xref-fn-deps (&optional ns symbol)\n  \"Show all functions referenced by the var matching NS and SYMBOL.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"fn-deps\")\n  (if-let* ((ns (or ns (cider-current-ns)))\n            (symbol (or symbol (cider-symbol-at-point)))\n            (results (cider-sync-request:fn-deps ns symbol)))\n      (cider-show-xref (format \"Showing %d function dependencies for %s\" (length results) symbol) results)\n    (message \"No dependencies found for %S\" symbol)))\n\n(defun cider-xref-act-on-symbol (symbol)\n  \"Apply selected action on SYMBOL.\"\n  (let* ((first-action-key (car (car cider-xref-actions)))\n         (action-key (if (= 1 (length cider-xref-actions))\n                         first-action-key\n                       (completing-read (format \"Choose action to apply to `%s` (default %s): \"\n                                                symbol first-action-key)\n                                        cider-xref-actions nil nil nil nil first-action-key)))\n         (action-fn (cdr (assoc action-key cider-xref-actions))))\n    (if action-fn\n        (funcall action-fn symbol)\n      (user-error \"Unknown action `%s`\" action-key))))\n\n;;;###autoload\n(defun cider-xref-fn-refs-select (&optional ns symbol)\n  \"Displays the references for NS and SYMBOL using completing read.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"fn-refs\")\n  (if-let* ((ns (or ns (cider-current-ns)))\n            (symbol (or symbol (cider-symbol-at-point)))\n            (results (mapcar (lambda (d) (nrepl-dict-get d \"name\")) (cider-sync-request:fn-refs ns symbol)))\n            (summary (format \"References for %s\" symbol)))\n      (cider-xref-act-on-symbol (completing-read (concat summary \": \") results))\n    (message \"No references for %S found\" symbol)))\n\n;;;###autoload\n(defun cider-xref-fn-deps-select (&optional ns symbol)\n  \"Displays the function dependencies for  NS and SYMBOL using completing read.\"\n  (interactive)\n  (cider-ensure-connected)\n  (cider-ensure-op-supported \"fn-deps\")\n  (if-let* ((ns (or ns (cider-current-ns)))\n            (symbol (or symbol (cider-symbol-at-point)))\n            (results (mapcar (lambda (d) (nrepl-dict-get d \"name\")) (cider-sync-request:fn-deps ns symbol)))\n            (summary (format \"Dependencies for %s\" symbol)))\n      (cider-xref-act-on-symbol (completing-read (concat summary \": \") results))\n    (message \"No dependencies for %S found\" symbol)))\n\n(provide 'cider-xref)\n\n;;; cider-xref.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"cider.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52857308,"end":52857340},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52857340},"to":{"change":3,"start":52779549,"end":52779549},"introduced_by":3}],"inode":{"change":3,"pos":52779549}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52779549},"to":{"change":3,"start":52779550,"end":52857307},"introduced_by":3}],"inode":{"change":3,"pos":52779549}},"content":[{"Del":";;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \n;; Maintainer: Bozhidar Batsov \n;; URL: http://www.github.com/clojure-emacs/cider\n;; Version: 1.6.0-snapshot\n;; Package-Requires: ((emacs \"26\") (clojure-mode \"5.15.1\") (parseedn \"1.0.6\") (queue \"0.2\") (spinner \"1.7\") (seq \"2.22\") (sesman \"0.3.2\"))\n;; Keywords: languages, clojure, cider\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;; This file is not part of GNU Emacs.\n\n;;; Commentary:\n\n;; Provides a Clojure interactive development environment for Emacs, built on\n;; top of nREPL.  See https://docs.cider.mx for more details.\n\n;;; Installation:\n\n;; CIDER is available as a package in melpa.org and stable.melpa.org.  First, make sure you've\n;; enabled one of the repositories in your Emacs config:\n\n;; (add-to-list 'package-archives\n;;              '(\"melpa\" . \"https://melpa.org/packages/\"))\n;;\n;; or\n;;\n;; (add-to-list 'package-archives\n;;              '(\"melpa-stable\" . \"https://stable.melpa.org/packages/\") t)\n\n;; Afterwards, installing CIDER is as easy as:\n\n;; M-x package-install cider\n\n;;; Usage:\n\n;; You can start CIDER with one of the following commands:\n\n;; M-x cider-jack-in-clj\n;; M-x cider-jack-in-cljs\n;;\n;; M-x cider-connect-sibling-clj\n;; M-x cider-connect-sibling-cljs\n;;\n;; M-x cider-connect-clj\n;; M-x cider-connect-cljs\n\n;;; Code:\n\n(defgroup cider nil\n  \"Clojure Interactive Development Environment that Rocks.\"\n  :prefix \"cider-\"\n  :group 'applications\n  :link '(url-link :tag \"GitHub\" \"https://github.com/clojure-emacs/cider\")\n  :link '(url-link :tag \"Homepage\" \"https://cider.mx\")\n  :link '(url-link :tag \"Documentation\" \"https://docs.cider.mx\")\n  :link '(emacs-commentary-link :tag \"Commentary\" \"cider\"))\n\n(require 'cider-client)\n(require 'cider-eldoc)\n(require 'cider-repl)\n(require 'cider-repl-history)\n(require 'cider-connection)\n(require 'cider-mode)\n(require 'cider-common)\n(require 'cider-debug)\n(require 'cider-util)\n\n(require 'tramp-sh)\n(require 'subr-x)\n(require 'seq)\n(require 'sesman)\n(require 'package)\n\n(defconst cider-version \"1.6.0-snapshot\"\n  \"The current version of CIDER.\")\n\n(defconst cider-codename \"Strasbourg\"\n  \"Codename used to denote stable releases.\")\n\n(defcustom cider-lein-command\n  \"lein\"\n  \"The command used to execute Leiningen.\"\n  :type 'string)\n\n(defcustom cider-lein-global-options\n  nil\n  \"Command global options used to execute Leiningen (e.g.: -o for offline).\"\n  :type 'string\n  :safe #'stringp)\n\n(defcustom cider-lein-parameters\n  \"repl :headless :host localhost\"\n  \"Params passed to Leiningen to start an nREPL server via `cider-jack-in'.\"\n  :type 'string\n  :safe #'stringp)\n\n(defcustom cider-boot-command\n  \"boot\"\n  \"The command used to execute Boot.\"\n  :type 'string\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-boot-global-options\n  nil\n  \"Command global options used to execute Boot (e.g.: -c for checkouts).\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.14.0\"))\n\n(defcustom cider-boot-parameters\n  \"repl -s -b localhost wait\"\n  \"Params passed to boot to start an nREPL server via `cider-jack-in'.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-clojure-cli-command\n  (if (and (eq system-type 'windows-nt)\n           (null (executable-find \"clojure\")))\n      \"powershell\"\n    \"clojure\")\n  \"The command used to execute clojure with tools.deps (requires Clojure 1.9+).\nDon't use clj here, as it doesn't work when spawned from Emacs due to it\nusing rlwrap.  If on Windows and no \\\"clojure\\\" executable is found we\ndefault to \\\"powershell\\\".\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-clojure-cli-global-options\n  nil\n  \"Command line options used to execute clojure with tools.deps.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-clojure-cli-aliases\n  nil\n  \"A list of aliases to include when using the clojure cli.\nAlias names should be of the form \\\":foo:bar\\\".\nLeading \\\"-A\\\" \\\"-M\\\" \\\"-T\\\" or \\\"-X\\\" are stripped from aliases\nthen concatenated into the \\\"-M[your-aliases]:cider/nrepl\\\" form.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"1.1\"))\n\n(defcustom cider-shadow-cljs-command\n  \"npx shadow-cljs\"\n  \"The command used to execute shadow-cljs.\n\nBy default we favor the project-specific shadow-cljs over the system-wide.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-shadow-cljs-global-options\n  \"\"\n  \"Command line options used to execute shadow-cljs (e.g.: -v for verbose mode).\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-shadow-cljs-parameters\n  \"server\"\n  \"Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.17.0\"))\n\n(defcustom cider-gradle-command\n  \"./gradlew\"\n  \"The command used to execute Gradle.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-gradle-global-options\n  \"\"\n  \"Command line options used to execute Gradle (e.g.: -m for dry run).\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.14.0\"))\n\n(defcustom cider-gradle-parameters\n  \"clojureRepl\"\n  \"Params passed to gradle to start an nREPL server via `cider-jack-in'.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"0.10.0\"))\n\n(defcustom cider-babashka-command\n  \"bb\"\n  \"The command used to execute Babashka.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"1.2.0\"))\n\n(defcustom cider-babashka-global-options\n  nil\n  \"Command line options used to execute Babashka.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"1.2.0\"))\n\n(defcustom cider-babashka-parameters\n  \"nrepl-server\"\n  \"Params passed to babashka to start an nREPL server via `cider-jack-in'.\"\n  :type 'string\n  :safe #'stringp\n  :package-version '(cider . \"1.2.0\"))\n\n(defcustom cider-jack-in-default (if (executable-find \"clojure\") 'clojure-cli 'lein)\n  \"The default tool to use when doing `cider-jack-in' outside a project.\nThis value will only be consulted when no identifying file types, i.e.\nproject.clj for leiningen or build.boot for boot, could be found.\n\nAs the Clojure CLI is bundled with Clojure itself, it's the default.\nIn the absence of the Clojure CLI (e.g. on Windows), we fallback\nto Leiningen.\"\n  :type '(choice (const lein)\n                 (const boot)\n                 (const clojure-cli)\n                 (const shadow-cljs)\n                 (const gradle)\n                 (const babashka))\n  :safe #'symbolp\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-preferred-build-tool\n  nil\n  \"Allow choosing a build system when there are many.\nWhen there are project markers from multiple build systems (e.g. lein and\nboot) the user is prompted to select one of them.  When non-nil, this\nvariable will suppress this behavior and will select whatever build system\nis indicated by the variable if present.  Note, this is only when CIDER\ncannot decide which of many build systems to use and will never override a\ncommand when there is no ambiguity.\"\n  :type '(choice (const lein)\n                 (const boot)\n                 (const clojure-cli)\n                 (const shadow-cljs)\n                 (const gradle)\n                 (const babashka)\n                 (const :tag \"Always ask\" nil))\n  :safe #'symbolp\n  :package-version '(cider . \"0.13.0\"))\n\n(defcustom cider-allow-jack-in-without-project 'warn\n  \"Controls what happens when doing `cider-jack-in' outside a project.\nWhen set to 'warn you'd prompted to confirm the command.\nWhen set to t `cider-jack-in' will quietly continue.\nWhen set to nil `cider-jack-in' will fail.\"\n  :type '(choice (const :tag \"always\" t)\n                 (const warn)\n                 (const :tag \"never\" nil))\n  :safe #'symbolp\n  :package-version '(cider . \"0.15.0\"))\n\n(defcustom cider-known-endpoints nil\n  \"A list of connection endpoints where each endpoint is a list.\nFor example: \\\\='((\\\"label\\\" \\\"host\\\" \\\"port\\\")).\nThe label is optional so that \\\\='(\\\"host\\\" \\\"port\\\") will suffice.\nThis variable is used by `cider-connect'.\"\n  :type '(repeat (list (string :tag \"label\")\n                       (string :tag \"host\")\n                       (string :tag \"port\"))))\n\n(defcustom cider-connected-hook nil\n  \"List of functions to call when connected to Clojure nREPL server.\"\n  :type 'hook\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-disconnected-hook nil\n  \"List of functions to call when disconnected from the Clojure nREPL server.\"\n  :type 'hook\n  :package-version '(cider . \"0.9.0\"))\n\n(defcustom cider-inject-dependencies-at-jack-in t\n  \"When nil, do not inject repl dependencies at `cider-jack-in' time.\nThe repl dependendcies are most likely to be nREPL middlewares.\"\n  :type 'boolean\n  :safe #'booleanp\n  :version '(cider . \"0.11.0\"))\n\n(defcustom cider-offer-to-open-cljs-app-in-browser t\n  \"When nil, do not offer to open ClojureScript apps in a browser on connect.\"\n  :type 'boolean\n  :safe #'booleanp\n  :version '(cider . \"0.15.0\"))\n\n(defvar cider-ps-running-nrepls-command \"ps u | grep leiningen\"\n  \"Process snapshot command used in `cider-locate-running-nrepl-ports'.\")\n\n(defvar cider-ps-running-nrepl-path-regexp-list\n  '(\"\\\\(?:leiningen.original.pwd=\\\\)\\\\(.+?\\\\) -D\"\n    \"\\\\(?:-classpath +:?\\\\(.+?\\\\)/self-installs\\\\)\")\n  \"Regexp list to get project paths.\nExtract project paths from output of `cider-ps-running-nrepls-command'.\nSub-match 1 must be the project path.\")\n\n(defvar cider-host-history nil\n  \"Completion history for connection hosts.\")\n\n;;;###autoload\n(defun cider-version ()\n  \"Display CIDER's version.\"\n  (interactive)\n  (message \"CIDER %s\" (cider--version)))\n\n(defun cider-jack-in-command (project-type)\n  \"Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE.\"\n  (pcase project-type\n    ('lein        cider-lein-command)\n    ('boot        cider-boot-command)\n    ('clojure-cli cider-clojure-cli-command)\n    ('babashka    cider-babashka-command)\n    ('shadow-cljs cider-shadow-cljs-command)\n    ('gradle      cider-gradle-command)\n    (_            (user-error \"Unsupported project type `%S'\" project-type))))\n\n(defun cider-jack-in-resolve-command (project-type)\n  \"Determine the resolved file path to `cider-jack-in-command'.\nThrows an error if PROJECT-TYPE is unknown.\"\n  (pcase project-type\n    ('lein (cider--resolve-command cider-lein-command))\n    ('boot (cider--resolve-command cider-boot-command))\n    ('clojure-cli (cider--resolve-command cider-clojure-cli-command))\n    ('babashka (cider--resolve-command cider-babashka-command))\n    ;; here we have to account for the possibility that the command is either\n    ;; \"npx shadow-cljs\" or just \"shadow-cljs\"\n    ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command)))\n                    (when-let* ((command (cider--resolve-command (car parts))))\n                      (mapconcat #'identity (cons command (cdr parts)) \" \"))))\n    ;; here we have to account for use of the Gradle wrapper which is\n    ;; a shell script within their project, so if they have a clearly\n    ;; relative path like \"./gradlew\" use locate file instead of checking\n    ;; the exec-path\n    ('gradle (cider--resolve-project-command cider-gradle-command))\n    (_ (user-error \"Unsupported project type `%S'\" project-type))))\n\n(defun cider-jack-in-global-options (project-type)\n  \"Determine the command line options for `cider-jack-in' for the PROJECT-TYPE.\"\n  (pcase project-type\n    ('lein        cider-lein-global-options)\n    ('boot        cider-boot-global-options)\n    ('clojure-cli cider-clojure-cli-global-options)\n    ('babashka    cider-babashka-global-options)\n    ('shadow-cljs cider-shadow-cljs-global-options)\n    ('gradle      cider-gradle-global-options)\n    (_            (user-error \"Unsupported project type `%S'\" project-type))))\n\n(defun cider-jack-in-params (project-type)\n  \"Determine the commands params for `cider-jack-in' for the PROJECT-TYPE.\"\n  ;; The format of these command-line strings must consider different shells,\n  ;; different values of IFS, and the possibility that they'll be run remotely\n  ;; (e.g. with TRAMP). Using `\", \"` causes problems with TRAMP, for example.\n  ;; Please be careful when changing them.\n  (pcase project-type\n    ('lein        cider-lein-parameters)\n    ('boot        cider-boot-parameters)\n    ('clojure-cli nil)\n    ('babashka    cider-babashka-parameters)\n    ('shadow-cljs cider-shadow-cljs-parameters)\n    ('gradle      cider-gradle-parameters)\n    (_            (user-error \"Unsupported project type `%S'\" project-type))))\n\n\f\n;;; Jack-in dependencies injection\n(defvar cider-jack-in-dependencies nil\n  \"List of dependencies where elements are lists of artifact name and version.\")\n(put 'cider-jack-in-dependencies 'risky-local-variable t)\n\n(defcustom cider-injected-nrepl-version \"1.0.0\"\n  \"The version of nREPL injected on jack-in.\nWe inject the newest known version of nREPL just in case\nyour version of Boot or Leiningen is bundling an older one.\"\n  :type 'string\n  :package-version '(cider . \"1.2.0\")\n  :safe #'stringp)\n\n(defvar cider-jack-in-cljs-dependencies nil\n  \"List of dependencies where elements are lists of artifact name and version.\nAdded to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.\")\n(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t)\n(cider-add-to-alist 'cider-jack-in-cljs-dependencies \"cider/piggieback\" \"0.5.2\")\n\n(defvar cider-jack-in-dependencies-exclusions nil\n  \"List of exclusions for jack in dependencies.\nElements of the list are artifact name and list of exclusions to apply for\nthe artifact.\")\n(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t)\n\n(defconst cider-clojure-artifact-id \"org.clojure/clojure\"\n  \"Artifact identifier for Clojure.\")\n\n(defconst cider-minimum-clojure-version \"1.8.0\"\n  \"Minimum supported version of Clojure.\")\n\n(defconst cider-latest-clojure-version \"1.10.1\"\n  \"Latest supported version of Clojure.\")\n\n(defconst cider-required-middleware-version \"0.28.7\"\n  \"The CIDER nREPL version that's known to work properly with CIDER.\")\n\n(defcustom cider-injected-middleware-version cider-required-middleware-version\n  \"The version of cider-nrepl injected on jack-in.\nShould be newer than the required version for optimal results.\"\n  :type 'string\n  :package-version '(cider . \"1.2.0\")\n  :safe #'stringp)\n\n(defcustom cider-enrich-classpath nil\n  \"Whether to use git.io/JiJVX for adding sources and javadocs to the classpath.\n\nThis is done in a clean manner, without interfering with classloaders.\n\nOnly available for Leiningen projects at the moment.\"\n  :type 'boolean\n  :package-version '(cider . \"1.2.0\")\n  :safe #'booleanp)\n\n(defcustom cider-jack-in-auto-inject-clojure nil\n  \"Version of clojure to auto-inject into REPL.\nIf nil, do not inject Clojure into the REPL.  If `latest', inject\n`cider-latest-clojure-version', which should approximate to the most recent\nversion of Clojure.  If `minimal', inject `cider-minimum-clojure-version',\nwhich will be the lowest version CIDER supports.  If a string, use this as\nthe version number.  If it is a list, the first element should be a string,\nspecifying the artifact ID, and the second element the version number.\"\n  :type '(choice (const :tag \"None\" nil)\n                 (const :tag \"Latest\" latest)\n                 (const :tag \"Minimal\" minimal)\n                 (string :tag \"Specific Version\")\n                 (list :tag \"Artifact ID and Version\"\n                       (string :tag \"Artifact ID\")\n                       (string :tag \"Version\"))))\n\n(defvar cider-jack-in-lein-plugins nil\n  \"List of Leiningen plugins to be injected at jack-in.\nEach element is a list of artifact name and version, followed optionally by\nkeyword arguments.  The only keyword argument currently accepted is\n`:predicate', which should be given a function that takes the list (name,\nversion, and keyword arguments) and returns non-nil to indicate that the\nplugin should actually be injected.  (This is useful primarily for packages\nthat extend CIDER, not for users.  For example, a refactoring package might\nwant to inject some middleware only when within a project context.)\")\n(put 'cider-jack-in-lein-plugins 'risky-local-variable t)\n\n(defvar cider-jack-in-lein-middlewares nil\n  \"List of Leiningen :middleware values to be injected at jack-in.\n\nNecessary for plugins which require an explicit middleware name to be specified.\n\nCan also facilitate using middleware in a specific order.\")\n(put 'cider-jack-in-lein-middlewares 'risky-local-variable t)\n\n(defvar cider-jack-in-cljs-lein-plugins nil\n  \"List of Leiningen plugins to be injected at jack-in.\nAdded to `cider-jack-in-lein-plugins' (which see) when doing\n`cider-jack-in-cljs'.\")\n(put 'cider-jack-in-cljs-lein-plugins 'risky-local-variable t)\n\n(defun cider-jack-in-normalized-lein-plugins ()\n  \"Return a normalized list of Leiningen plugins to be injected.\nSee `cider-jack-in-lein-plugins' for the format, except that the list\nreturned by this function does not include keyword arguments.\"\n  (let ((plugins (if cider-enrich-classpath\n                     (append cider-jack-in-lein-plugins\n                             `((\"cider/cider-nrepl\" ,cider-injected-middleware-version)\n                               (\"mx.cider/enrich-classpath\" \"1.9.0\")))\n                   (append cider-jack-in-lein-plugins\n                           `((\"cider/cider-nrepl\" ,cider-injected-middleware-version))))))\n    (thread-last\n      plugins\n      (seq-filter\n       (lambda (spec)\n         (if-let* ((pred (plist-get (seq-drop spec 2) :predicate)))\n             (funcall pred spec)\n           t)))\n      (mapcar\n       (lambda (spec)\n         (seq-take spec 2))))))\n\n(defvar cider-jack-in-nrepl-middlewares nil\n  \"List of Clojure variable names.\nEach of these Clojure variables should hold a vector of nREPL middlewares.\nInstead of a string, an element can be a list containing a string followed\nby optional keyword arguments.  The only keyword argument currently\naccepted is `:predicate', which should be given a function that takes the\nlist (string and keyword arguments) and returns non-nil to indicate that\nthe middlewares should actually be injected.\")\n(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t)\n(add-to-list 'cider-jack-in-nrepl-middlewares \"cider.nrepl/cider-middleware\")\n\n(defvar cider-jack-in-cljs-nrepl-middlewares nil\n  \"List of Clojure variable names.\nAdded to `cider-jack-in-nrepl-middlewares' (which see) when doing\n`cider-jack-in-cljs'.\")\n(put 'cider-jack-in-cljs-nrepl-middlewares 'risky-local-variable t)\n(add-to-list 'cider-jack-in-cljs-nrepl-middlewares \"cider.piggieback/wrap-cljs-repl\")\n\n(defun cider-jack-in-normalized-nrepl-middlewares ()\n  \"Return a normalized list of middleware variable names.\nSee `cider-jack-in-nrepl-middlewares' for the format, except that the list\nreturned by this function only contains strings.\"\n  (thread-last\n    cider-jack-in-nrepl-middlewares\n    (seq-filter\n     (lambda (spec)\n       (or (not (listp spec))\n           (if-let* ((pred (plist-get (cdr spec) :predicate)))\n               (funcall pred spec)\n             t))))\n    (mapcar\n     (lambda (spec)\n       (if (listp spec)\n           (car spec)\n         spec)))))\n\n(defun cider--list-as-boot-artifact (list)\n  \"Return a boot artifact string described by the elements of LIST.\nLIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION).  The returned\nstring is quoted for passing as argument to an inferior shell.\"\n  (concat \"-d \" (shell-quote-argument (format \"%s:%s\" (car list) (cadr list)))))\n\n(defun cider--jack-in-required-dependencies ()\n  \"Returns the required CIDER deps.\nThey are normally added to `cider-jack-in-dependencies',\nunless it's a Lein project.\"\n  `((\"nrepl/nrepl\" ,cider-injected-nrepl-version)\n    (\"cider/cider-nrepl\" ,cider-injected-middleware-version)))\n\n(defun cider-boot-dependencies (dependencies)\n  \"Return a list of boot artifact strings created from DEPENDENCIES.\"\n  (concat (mapconcat #'cider--list-as-boot-artifact dependencies \" \")\n          (unless (seq-empty-p dependencies) \" \")))\n\n(defun cider-boot-middleware-task (params middlewares)\n  \"Create a command to add MIDDLEWARES with corresponding PARAMS.\"\n  (concat \"cider.tasks/add-middleware \"\n          (mapconcat (lambda (middleware)\n                       (format \"-m %s\" (shell-quote-argument middleware)))\n                     middlewares\n                     \" \")\n          \" \" params))\n\n(defun cider-boot-jack-in-dependencies (global-opts params dependencies middlewares)\n  \"Create boot jack-in dependencies.\nDoes so by concatenating GLOBAL-OPTS, DEPENDENCIES,\nand MIDDLEWARES.  PARAMS and MIDDLEWARES are passed on to\n`cider-boot-middleware-task` before concatenating and DEPENDENCIES\n are passed on to `cider-boot-dependencies`.\"\n  (concat global-opts\n          (unless (seq-empty-p global-opts) \" \")\n          \"-i \\\"(require 'cider.tasks)\\\" \" ;; Note the space at the end here\n          (cider-boot-dependencies (append (cider--jack-in-required-dependencies) dependencies))\n          (cider-boot-middleware-task params middlewares)))\n\n(defun cider--gradle-dependency-notation (dependency)\n  \"Returns Gradle's GAV dependency syntax.\nFor a \\\"group/artifact\\\" \\\"version\\\") DEPENDENCY list\nreturn as group:artifact:version notation.\"\n  (let ((group-artifact (replace-regexp-in-string \"/\" \":\" (car dependency)))\n        (version (cadr dependency)))\n    (format \"%s:%s\" group-artifact version)))\n\n(defun cider--gradle-jack-in-property (dependencies)\n  \"Returns Clojurephant's dependency jack-in property.\nFor DEPENDENCIES, translates to Gradle's dependency notation\nusing `cider--gradle-dependency-notation`.''\"\n  (if (seq-empty-p dependencies)\n      \"\"\n    (shell-quote-argument\n     (concat \"-Pdev.clojurephant.jack-in.nrepl=\"\n             (mapconcat #'cider--gradle-dependency-notation dependencies \",\")))))\n\n(defun cider--gradle-middleware-params (middlewares)\n  \"Returns Gradle-formatted middleware params.\nGiven a list of MIDDLEWARES symbols, this returns\nthe Gradle parameters expected by Clojurephant's\nClojureNRepl task.\"\n  (mapconcat (lambda (middleware)\n               (shell-quote-argument (concat \"--middleware=\" middleware)))\n             middlewares\n             \" \"))\n\n(defun cider-gradle-jack-in-dependencies (global-opts params dependencies middlewares)\n  \"Create gradle jack in dependencies.\nDoes so by concatenating GLOBAL-OPTS, DEPENDENCIES,\nand MIDDLEWARES.  GLOBAL-OPTS and PARAMS are taken as-is.\nDEPENDENCIES are translated into Gradle's typical\ngroup:artifact:version notation and MIDDLEWARES are\nprepared as arguments to Clojurephant's ClojureNRepl task.\"\n  (concat global-opts\n          (unless (seq-empty-p global-opts) \" \")\n          (cider--gradle-jack-in-property (append (cider--jack-in-required-dependencies) dependencies))\n          \" \"\n          params\n          (unless (seq-empty-p params) \" \")\n          (cider--gradle-middleware-params middlewares)))\n\n(defun cider--lein-artifact-exclusions (exclusions)\n  \"Return an exclusions vector described by the elements of EXCLUSIONS.\"\n  (if exclusions\n      (format \" :exclusions [%s]\" (mapconcat #'identity exclusions \" \"))\n    \"\"))\n\n(defun cider--list-as-lein-artifact (list &optional exclusions)\n  \"Return an artifact string described by the elements of LIST.\nLIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION).  Optionally a list\nof EXCLUSIONS can be provided as well.  The returned\nstring is quoted for passing as argument to an inferior shell.\"\n  (shell-quote-argument (format \"[%s %S%s]\" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions))))\n\n(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins &optional lein-middlewares)\n  \"Create lein jack-in dependencies.\nDoes so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS\nremoved, LEIN-PLUGINS, LEIN-MIDDLEWARES and finally PARAMS.\"\n  (concat\n   global-opts\n   (unless (seq-empty-p global-opts) \" \")\n   (mapconcat #'identity\n              (append (seq-map (lambda (dep)\n                                 (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions))))\n                                   (concat \"update-in :dependencies conj \"\n                                           (cider--list-as-lein-artifact dep exclusions))))\n                               dependencies)\n                      (seq-map (lambda (plugin)\n                                 (concat \"update-in :plugins conj \"\n                                         (cider--list-as-lein-artifact plugin)))\n                               lein-plugins)\n                      (seq-map (lambda (middleware)\n                                 (concat \"update-in :middleware conj \"\n                                         middleware))\n                               lein-middlewares))\n              \" -- \")\n   \" -- \"\n   params))\n\n(defun cider--dedupe-deps (deps)\n  \"Removes the duplicates in DEPS.\"\n  (cl-delete-duplicates deps :test 'equal))\n\n(defun cider-clojure-cli-jack-in-dependencies (global-options _params dependencies)\n  \"Create Clojure tools.deps jack-in dependencies.\nDoes so by concatenating DEPENDENCIES and GLOBAL-OPTIONS into a suitable\n`clojure` invocation.  The main is placed in an inline alias :cider/nrepl\nso that if your aliases contain any mains, the cider/nrepl one will be the\none used.\"\n  (let* ((all-deps (thread-last\n                     dependencies\n                     (append (cider--jack-in-required-dependencies))\n                     ;; Duplicates are never OK since they would result in\n                     ;; `java.lang.IllegalArgumentException: Duplicate key [...]`:\n                     (cider--dedupe-deps)\n                     (seq-map (lambda (dep)\n                                (format \"%s {:mvn/version \\\"%s\\\"}\" (car dep) (cadr dep))))))\n         (middleware (mapconcat\n                      (apply-partially #'format \"%s\")\n                      (cider-jack-in-normalized-nrepl-middlewares)\n                      \",\"))\n         (main-opts (format \"\\\"-m\\\" \\\"nrepl.cmdline\\\" \\\"--middleware\\\" \\\"[%s]\\\"\" middleware)))\n    (format \"%s-Sdeps '{:deps {%s} :aliases {:cider/nrepl {:main-opts [%s]}}}' -M%s:cider/nrepl\"\n            (if global-options (format \"%s \" global-options) \"\")\n            (string-join all-deps \" \")\n            main-opts\n            (if cider-clojure-cli-aliases\n                ;; remove exec-opts flags -A -M -T or -X from cider-clojure-cli-aliases\n                ;; concatenated with :cider/nrepl to ensure :cider/nrepl comes last\n                (format \"%s\" (replace-regexp-in-string \"^-\\\\(A\\\\|M\\\\|T\\\\|X\\\\)\" \"\" cider-clojure-cli-aliases))\n              \"\"))))\n\n(defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies)\n  \"Create shadow-cljs jack-in deps.\nDoes so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS.\"\n  (let ((dependencies (append (cider--jack-in-required-dependencies) dependencies)))\n    (concat\n     global-opts\n     (unless (seq-empty-p global-opts) \" \")\n     (mapconcat #'identity\n                (seq-map (lambda (dep) (format \"-d %s:%s\" (car dep) (cadr dep))) dependencies)\n                \" \")\n     \" \"\n     params)))\n\n(defun cider-add-clojure-dependencies-maybe (dependencies)\n  \"Return DEPENDENCIES with an added Clojure dependency if requested.\nSee also `cider-jack-in-auto-inject-clojure'.\"\n  (if cider-jack-in-auto-inject-clojure\n      (if (consp cider-jack-in-auto-inject-clojure)\n          (cons cider-jack-in-auto-inject-clojure dependencies)\n        (cons (list cider-clojure-artifact-id\n                    (cond\n                     ((stringp cider-jack-in-auto-inject-clojure)\n                      cider-jack-in-auto-inject-clojure)\n                     ((eq cider-jack-in-auto-inject-clojure 'minimal)\n                      cider-minimum-clojure-version)\n                     ((eq cider-jack-in-auto-inject-clojure 'latest)\n                      cider-latest-clojure-version)))\n              dependencies))\n    dependencies))\n\n(defun cider-inject-jack-in-dependencies (global-opts params project-type)\n  \"Return GLOBAL-OPTS and PARAMS with injected REPL dependencies.\nThese are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and\n`cider-jack-in-nrepl-middlewares' are injected from the CLI according to\nthe used PROJECT-TYPE.  Eliminates the need for hacking profiles.clj or the\nboot script for supporting CIDER with its nREPL middleware and\ndependencies.\"\n  (pcase project-type\n    ('lein (cider-lein-jack-in-dependencies\n            global-opts\n            params\n            (cider-add-clojure-dependencies-maybe\n             (append `((\"nrepl/nrepl\" ,cider-injected-nrepl-version)) cider-jack-in-dependencies))\n            cider-jack-in-dependencies-exclusions\n            (cider-jack-in-normalized-lein-plugins)\n            (if cider-enrich-classpath\n                (append cider-jack-in-lein-middlewares\n                        '(\"cider.enrich-classpath/middleware\"))\n              cider-jack-in-lein-middlewares)))\n    ('boot (cider-boot-jack-in-dependencies\n            global-opts\n            params\n            (cider-add-clojure-dependencies-maybe\n             cider-jack-in-dependencies)\n            (cider-jack-in-normalized-nrepl-middlewares)))\n    ('clojure-cli (cider-clojure-cli-jack-in-dependencies\n                   global-opts\n                   params\n                   (cider-add-clojure-dependencies-maybe\n                    cider-jack-in-dependencies)))\n    ('babashka (concat\n                global-opts\n                (unless (seq-empty-p global-opts) \" \")\n                params))\n    ('shadow-cljs (cider-shadow-cljs-jack-in-dependencies\n                   global-opts\n                   params\n                   (cider-add-clojure-dependencies-maybe\n                    cider-jack-in-dependencies)))\n    ('gradle (cider-gradle-jack-in-dependencies\n              global-opts\n              params\n              (cider-add-clojure-dependencies-maybe\n               cider-jack-in-dependencies)\n              (cider-jack-in-normalized-nrepl-middlewares)))\n    (_ (error \"Unsupported project type `%S'\" project-type))))\n\n\f\n;;; ClojureScript REPL creation\n\n(defcustom cider-check-cljs-repl-requirements t\n  \"When non-nil will run the requirement checks for the different cljs repls.\nGenerally you should not disable this unless you run into some faulty check.\"\n  :type 'boolean\n  :safe #'booleanp\n  :package-version '(cider . \"0.17.0\"))\n\n(defun cider-verify-clojurescript-is-present ()\n  \"Check whether ClojureScript is present.\"\n  (unless (cider-library-present-p \"cljs.core\")\n    (user-error \"ClojureScript is not available.  See https://docs.cider.mx/cider/basics/clojurescript for details\")))\n\n(defun cider-verify-piggieback-is-present ()\n  \"Check whether the piggieback middleware is present.\"\n  (unless (cider-library-present-p \"cider.piggieback\")\n    (user-error \"Piggieback 0.4.x (aka cider/piggieback) is not available.  See https://docs.cider.mx/cider/basics/clojurescript for details\")))\n\n(defun cider-check-node-requirements ()\n  \"Check whether we can start a Node ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (executable-find \"node\")\n    (user-error \"Node.js is not present on the exec-path.  Make sure you've installed it and your exec-path is properly set\")))\n\n(defun cider-check-figwheel-requirements ()\n  \"Check whether we can start a Figwheel ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (cider-library-present-p \"figwheel-sidecar.repl\")\n    (user-error \"Figwheel-sidecar is not available.  Please check https://docs.cider.mx/cider/basics/clojurescript for details\")))\n\n(defun cider-check-figwheel-main-requirements ()\n  \"Check whether we can start a Figwheel ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (cider-library-present-p \"figwheel.main\")\n    (user-error \"Figwheel-main is not available.  Please check https://docs.cider.mx/cider/basics/clojurescript for details\")))\n\n(defun cider-check-weasel-requirements ()\n  \"Check whether we can start a Weasel ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (cider-library-present-p \"weasel.repl.server\")\n    (user-error \"Weasel in not available.  Please check https://docs.cider.mx/cider/basics/clojurescript/#browser-connected-clojurescript-repl for details\")))\n\n(defun cider-check-boot-requirements ()\n  \"Check whether we can start a Boot ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (cider-library-present-p \"adzerk.boot-cljs-repl\")\n    (user-error \"The Boot ClojureScript REPL is not available.  Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md for details\")))\n\n(defun cider-check-krell-requirements ()\n  \"Check whether we can start a Krell ClojureScript REPL.\"\n  (cider-verify-piggieback-is-present)\n  (unless (cider-library-present-p \"krell.repl\")\n    (user-error \"The Krell ClojureScript REPL is not available.  Please check https://github.com/vouch-opensource/krell for details\")))\n\n(defun cider-check-shadow-cljs-requirements ()\n  \"Check whether we can start a shadow-cljs REPL.\"\n  (unless (cider-library-present-p \"shadow.cljs.devtools.api\")\n    (user-error \"The shadow-cljs ClojureScript REPL is not available.  Please check https://docs.cider.mx/cider/basics/clojurescript for details\")))\n\n(defun cider-normalize-cljs-init-options (options)\n  \"Normalize the OPTIONS string used for initializing a ClojureScript REPL.\"\n  (if (or (string-prefix-p \"{\" options)\n          (string-prefix-p \"(\" options)\n          (string-prefix-p \"[\" options)\n          (string-prefix-p \":\" options)\n          (string-prefix-p \"\\\"\" options))\n      options\n    (concat \":\" options)))\n\n(defcustom cider-shadow-watched-builds nil\n  \"Defines the list of builds `shadow-cljs' should watch.\"\n  :type '(repeat string)\n  :safe #'listp\n  :package-version '(cider . \"1.0\"))\n\n(defcustom cider-shadow-default-options nil\n  \"Defines default `shadow-cljs' options.\"\n  :type 'string\n  :safe (lambda (s) (or (null s) (stringp s)))\n  :package-version '(cider . \"0.18.0\"))\n\n(defun cider--shadow-parse-builds (hash)\n  \"Parses the build names of a shadow-cljs.edn HASH map.\nThe default options of `browser-repl' and `node-repl' are also included.\"\n  (let* ((builds (when (hash-table-p hash)\n                   (gethash :builds hash)))\n         (build-keys (when (hash-table-p builds)\n                       (hash-table-keys builds))))\n    (append build-keys '(browser-repl node-repl))))\n\n(defun cider--shadow-get-builds ()\n  \"Extract build names from the shadow-cljs.edn config file in the project root.\"\n  (let ((shadow-edn (concat (clojure-project-dir) \"shadow-cljs.edn\")))\n    (when (file-exists-p shadow-edn)\n      (with-temp-buffer\n        (insert-file-contents shadow-edn)\n        (let ((hash (car (parseedn-read '((shadow/env . identity))))))\n          (cider--shadow-parse-builds hash))))))\n\n(defun cider-shadow-select-cljs-init-form ()\n  \"Generate the init form for a shadow-cljs select-only REPL.\nWe have to prompt the user to select a build, that's why this is a command,\nnot just a string.\"\n  (let ((form \"(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))\")\n        (options (or cider-shadow-default-options\n                     (completing-read \"Select shadow-cljs build: \"\n                                      (cider--shadow-get-builds)))))\n    (format form (cider-normalize-cljs-init-options options))))\n\n(defun cider-shadow-cljs-init-form ()\n  \"Generate the init form for a shadow-cljs REPL.\nWe have to prompt the user to select a build, that's why\nthis is a command, not just a string.\"\n  (let* ((shadow-require \"(require '[shadow.cljs.devtools.api :as shadow])\")\n\n         (default-build (cider-normalize-cljs-init-options\n                         (or cider-shadow-default-options\n                             (car cider-shadow-watched-builds)\n                             (completing-read \"Select shadow-cljs build: \"\n                                              (cider--shadow-get-builds)))))\n\n         (watched-builds (or (mapcar #'cider-normalize-cljs-init-options cider-shadow-watched-builds)\n                             (list default-build)))\n\n         (watched-builds-form (mapconcat (lambda (build) (format \"(shadow/watch %s)\" build))\n                                         watched-builds\n                                         \" \"))\n         ;; form used for user-defined builds\n         (user-build-form \"(do %s %s (shadow/nrepl-select %s))\")\n         ;; form used for built-in builds like :browser-repl and :node-repl\n         (default-build-form \"(do %s (shadow/%s))\"))\n    (if (member default-build '(\":browser-repl\" \":node-repl\"))\n        (format default-build-form shadow-require (string-remove-prefix \":\" default-build))\n      (format user-build-form shadow-require watched-builds-form default-build))))\n\n(defcustom cider-figwheel-main-default-options nil\n  \"Defines the `figwheel.main/start' options.\n\nNote that figwheel-main/start can also accept a map of options, refer to\nFigwheel for details.\"\n  :type 'string\n  :safe (lambda (s) (or (null s) (stringp s)))\n  :package-version '(cider . \"0.18.0\"))\n\n(defun cider--figwheel-main-get-builds ()\n  \"Extract build names from the .cljs.edn config files.\nFetches them in the project root.\"\n  (when-let ((project-dir (clojure-project-dir)))\n    (let ((builds (directory-files project-dir nil \".*\\\\.cljs\\\\.edn\")))\n      (mapcar (lambda (f) (string-match \"^\\\\(.*\\\\)\\\\.cljs\\\\.edn\" f)\n                (match-string 1 f))\n              builds))))\n\n(defun cider-figwheel-main-init-form ()\n  \"Produce the figwheel-main ClojureScript init form.\"\n  (let ((form \"(do (require 'figwheel.main) (figwheel.main/start %s))\")\n        (builds (cider--figwheel-main-get-builds)))\n    (cond\n     (cider-figwheel-main-default-options\n      (format form (cider-normalize-cljs-init-options (string-trim cider-figwheel-main-default-options))))\n\n     (builds\n      (format form (cider-normalize-cljs-init-options (completing-read \"Select figwheel-main build: \" builds))))\n\n     (t (user-error \"No figwheel-main build files (.cljs.edn) were found\")))))\n\n(defcustom cider-custom-cljs-repl-init-form nil\n  \"The form used to start a custom ClojureScript REPL.\nWhen set it becomes the return value of the `cider-custom-cljs-repl-init-form'\nfunction, which normally prompts for the init form.\n\nThis defcustom is mostly intended for use with .dir-locals.el for\ncases where it doesn't make sense to register a new ClojureScript REPL type.\"\n  :type 'string\n  :safe (lambda (s) (or (null s) (stringp s)))\n  :package-version '(cider . \"0.23.0\"))\n\n(defun cider-custom-cljs-repl-init-form ()\n  \"The form used to start a custom ClojureScript REPL.\nDefaults to the value of `cider-custom-cljs-repl-init-form'.\nIf it's nil the function will prompt for a form.\nThe supplied string will be wrapped in a do form if needed.\"\n  (or\n   cider-custom-cljs-repl-init-form\n   (let ((form (read-from-minibuffer \"Please, provide a form to start a ClojureScript REPL: \")))\n     ;; TODO: We should probably make this more robust (e.g. by using a regexp or\n     ;; parsing the form).\n     (if (string-prefix-p \"(do\" form)\n         form\n       (format \"(do %s)\" form)))))\n\n(defvar cider-cljs-repl-types\n  '((figwheel \"(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))\"\n              cider-check-figwheel-requirements)\n    (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements)\n    (figwheel-connected \"(figwheel-sidecar.repl-api/cljs-repl)\"\n                        cider-check-figwheel-requirements)\n    (browser \"(do (require 'cljs.repl.browser) (cider.piggieback/cljs-repl (cljs.repl.browser/repl-env)))\")\n    (node \"(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))\"\n          cider-check-node-requirements)\n    (weasel \"(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \\\"127.0.0.1\\\" :port 9001)))\"\n            cider-check-weasel-requirements)\n    (boot \"(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))\"\n          cider-check-boot-requirements)\n    (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements)\n    (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements)\n    (krell \"(require '[clojure.edn :as edn]\n         '[clojure.java.io :as io]\n         '[cider.piggieback]\n         '[krell.api :as krell]\n         '[krell.repl])\n(def config (edn/read-string (slurp (io/file \\\"build.edn\\\"))))\n(apply cider.piggieback/cljs-repl (krell.repl/repl-env) (mapcat identity config))\"\n           cider-check-krell-requirements)\n    (custom cider-custom-cljs-repl-init-form nil))\n  \"A list of supported ClojureScript REPLs.\n\nFor each one we have its name, the form we need to evaluate in a Clojure\nREPL to start the ClojureScript REPL and functions to verify their requirements.\n\nThe form should be either a string or a function producing a string.\")\n\n(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn)\n  \"Register a new ClojureScript REPL type.\n\nTypes are defined by the following:\n\n- TYPE - symbol identifier that will be used to refer to the REPL type\n- INIT-FORM - string or function (symbol) producing string\n- REQUIREMENTS-FN - function to check whether the REPL can be started.\nThis param is optional.\n\nAll this function does is modifying `cider-cljs-repl-types'.\nIt's intended to be used in your Emacs config.\"\n  (unless (symbolp type)\n    (user-error \"The REPL type must be a symbol\"))\n  (unless (or (stringp init-form) (symbolp init-form))\n    (user-error \"The init form must be a string or a symbol referring to a function\"))\n  (unless (or (null requirements-fn) (symbolp requirements-fn))\n    (user-error \"The requirements-fn must be a symbol referring to a function\"))\n  (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn)))\n\n(defcustom cider-default-cljs-repl nil\n  \"The default ClojureScript REPL to start.\nThis affects commands like `cider-jack-in-cljs'.  Generally it's\nintended to be set via .dir-locals.el for individual projects, as its\nrelatively unlikely you'd like to use the same type of REPL in each project\nyou're working on.\"\n  :type '(choice (const :tag \"Figwheel\" figwheel)\n                 (const :tag \"Figwheel Main\" figwheel-main)\n                 (const :tag \"Browser\"  browser)\n                 (const :tag \"Node\"     node)\n                 (const :tag \"Weasel\"   weasel)\n                 (const :tag \"Boot\"     boot)\n                 (const :tag \"Shadow\"   shadow)\n                 (const :tag \"Shadow w/o Server\" shadow-select)\n                 (const :tag \"Krell\"    krell)\n                 (const :tag \"Custom\"   custom))\n  :safe #'symbolp\n  :package-version '(cider . \"0.17.0\"))\n\n(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl \"0.17\")\n(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl \"0.17\")\n(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl \"0.17\")\n\n(defvar cider--select-cljs-repl-history nil)\n(defun cider-select-cljs-repl (&optional default)\n  \"Select the ClojureScript REPL to use with `cider-jack-in-cljs'.\nDEFAULT is the default ClojureScript REPL to offer in completion.\"\n  (let ((repl-types (mapcar #'car cider-cljs-repl-types)))\n    (intern (completing-read \"Select ClojureScript REPL type: \" repl-types\n                             nil nil nil 'cider--select-cljs-repl-history\n                             (or default (car cider--select-cljs-repl-history))))))\n\n(defun cider-cljs-repl-form (repl-type)\n  \"Get the cljs REPL form for REPL-TYPE.\"\n  (if-let* ((repl-form (cadr (seq-find\n                              (lambda (entry)\n                                (eq (car entry) repl-type))\n                              cider-cljs-repl-types))))\n      ;; repl-form can be either a string or a function producing a string\n      (if (symbolp repl-form)\n          (funcall repl-form)\n        repl-form)\n    (user-error \"No ClojureScript REPL type %s found.  Please make sure that `cider-cljs-repl-types' has an entry for it\" repl-type)))\n\n(defun cider-verify-cljs-repl-requirements (&optional repl-type)\n  \"Verify that the requirements for REPL-TYPE are met.\nReturn REPL-TYPE if requirements are met.\"\n  (let ((repl-type (or repl-type\n                       cider-default-cljs-repl\n                       (cider-select-cljs-repl))))\n    (when cider-check-cljs-repl-requirements\n      (when-let* ((fun (nth 2 (seq-find\n                               (lambda (entry)\n                                 (eq (car entry) repl-type))\n                               cider-cljs-repl-types))))\n        (funcall fun)))\n    repl-type))\n\n(defun cider--check-cljs (&optional cljs-type no-error)\n  \"Verify that all cljs requirements are met for CLJS-TYPE connection.\nReturn REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise.\nWhen NO-ERROR is non-nil, don't throw an error, issue a message and return\nnil.\"\n  (if no-error\n      (condition-case ex\n          (progn\n            (cider-verify-clojurescript-is-present)\n            (cider-verify-cljs-repl-requirements cljs-type))\n        (error\n         (message \"Invalid ClojureScript dependency: %S\" ex)\n         nil))\n    (cider-verify-clojurescript-is-present)\n    (cider-verify-cljs-repl-requirements cljs-type)))\n\n(defun cider--offer-to-open-app-in-browser (server-buffer)\n  \"Look for a server address in SERVER-BUFFER and offer to open it.\"\n  (when (buffer-live-p server-buffer)\n    (with-current-buffer server-buffer\n      (save-excursion\n        (goto-char (point-min))\n        (when-let* ((url (and (search-forward-regexp \"http://localhost:[0-9]+\" nil 'noerror)\n                              (match-string 0))))\n          (when (y-or-n-p (format \"Visit ‘%s’ in a browser? \" url))\n            (browse-url url)))))))\n\n\f\n;;; User Level Connectors\n\n;;;###autoload (autoload 'cider-start-map \"cider\" \"CIDER jack-in and connect keymap.\" t 'keymap)\n(defvar cider-start-map\n  (let ((map (define-prefix-command 'cider-start-map)))\n    (define-key map (kbd \"x\") #'cider)\n    (define-key map (kbd \"C-x\") #'cider)\n    (define-key map (kbd \"j j\") #'cider-jack-in-clj)\n    (define-key map (kbd \"j s\") #'cider-jack-in-cljs)\n    (define-key map (kbd \"j m\") #'cider-jack-in-clj&cljs)\n    (define-key map (kbd \"C-j j\") #'cider-jack-in-clj)\n    (define-key map (kbd \"C-j s\") #'cider-jack-in-cljs)\n    (define-key map (kbd \"C-j m\") #'cider-jack-in-clj&cljs)\n    (define-key map (kbd \"C-j C-j\") #'cider-jack-in-clj)\n    (define-key map (kbd \"C-j C-s\") #'cider-jack-in-cljs)\n    (define-key map (kbd \"C-j C-m\") #'cider-jack-in-clj&cljs)\n    (define-key map (kbd \"c j\") #'cider-connect-clj)\n    (define-key map (kbd \"c s\") #'cider-connect-cljs)\n    (define-key map (kbd \"c m\") #'cider-connect-clj&cljs)\n    (define-key map (kbd \"C-c j\") #'cider-connect-clj)\n    (define-key map (kbd \"C-c s\") #'cider-connect-cljs)\n    (define-key map (kbd \"C-c m\") #'cider-connect-clj&cljs)\n    (define-key map (kbd \"C-c C-j\") #'cider-connect-clj)\n    (define-key map (kbd \"C-c C-s\") #'cider-connect-cljs)\n    (define-key map (kbd \"C-c C-m\") #'cider-connect-clj&cljs)\n    (define-key map (kbd \"s j\") #'cider-connect-sibling-clj)\n    (define-key map (kbd \"s s\") #'cider-connect-sibling-cljs)\n    (define-key map (kbd \"C-s j\") #'cider-connect-sibling-clj)\n    (define-key map (kbd \"C-s s\") #'cider-connect-sibling-cljs)\n    (define-key map (kbd \"C-s C-j\") #'cider-connect-sibling-clj)\n    (define-key map (kbd \"C-s C-s\") #'cider-connect-sibling-cljs)\n    map)\n  \"CIDER jack-in and connect keymap.\")\n\n;;;###autoload\n(defun cider-jack-in-clj (params)\n  \"Start an nREPL server for the current project and connect to it.\nPARAMS is a plist optionally containing :project-dir and :jack-in-cmd.\nWith the prefix argument, allow editing of the jack in command; with a\ndouble prefix prompt for all these parameters.\"\n  (interactive \"P\")\n  (let ((params (thread-first\n                  params\n                  (cider--update-project-dir)\n                  (cider--check-existing-session)\n                  (cider--update-jack-in-cmd))))\n    (nrepl-start-server-process\n     (plist-get params :project-dir)\n     (plist-get params :jack-in-cmd)\n     (lambda (server-buffer)\n       (cider-connect-sibling-clj params server-buffer)))))\n\n;;;###autoload\n(defun cider-jack-in-cljs (params)\n  \"Start an nREPL server for the current project and connect to it.\nPARAMS is a plist optionally containing :project-dir, :jack-in-cmd and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  With the prefix argument,\nallow editing of the jack in command; with a double prefix prompt for all\nthese parameters.\"\n  (interactive \"P\")\n  (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies))\n        (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins))\n        (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares))\n        (orig-buffer (current-buffer)))\n    ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars\n    (let ((params (thread-first\n                    params\n                    (cider--update-project-dir)\n                    (cider--check-existing-session)\n                    (cider--update-jack-in-cmd))))\n      (nrepl-start-server-process\n       (plist-get params :project-dir)\n       (plist-get params :jack-in-cmd)\n       (lambda (server-buffer)\n         (with-current-buffer orig-buffer\n           (cider-connect-sibling-cljs params server-buffer)))))))\n\n;;;###autoload\n(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start)\n  \"Start an nREPL server and connect with clj and cljs REPLs.\nPARAMS is a plist optionally containing :project-dir, :jack-in-cmd and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  With the prefix argument,\nallow for editing of the jack in command; with a double prefix prompt for\nall these parameters.  When SOFT-CLJS-START is non-nil, start cljs REPL\nonly when the ClojureScript dependencies are met.\"\n  (interactive \"P\")\n  (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies))\n        (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins))\n        (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares))\n        (orig-buffer (current-buffer)))\n    ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars\n    (let ((params (thread-first\n                    params\n                    (cider--update-project-dir)\n                    (cider--check-existing-session)\n                    (cider--update-jack-in-cmd)\n                    (cider--update-cljs-type)\n                    ;; already asked, don't ask on sibling connect\n                    (plist-put :do-prompt nil))))\n      (nrepl-start-server-process\n       (plist-get params :project-dir)\n       (plist-get params :jack-in-cmd)\n       (lambda (server-buffer)\n         (with-current-buffer orig-buffer\n           (let ((clj-repl (cider-connect-sibling-clj params server-buffer)))\n             (if soft-cljs-start\n                 (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error)\n                   (cider-connect-sibling-cljs params clj-repl))\n               (cider-connect-sibling-cljs params clj-repl)))))))))\n\n;;;###autoload\n(defun cider-connect-sibling-clj (params &optional other-repl)\n  \"Create a Clojure REPL with the same server as OTHER-REPL.\nPARAMS is for consistency with other connection commands and is currently\nignored.  OTHER-REPL defaults to `cider-current-repl' and in programs can\nalso be a server buffer, in which case a new session with a REPL for that\nserver is created.\"\n  (interactive \"P\")\n  (cider-nrepl-connect\n   (let* ((other-repl (or other-repl (cider-current-repl 'any 'ensure)))\n          (other-params (cider--gather-connect-params nil other-repl))\n          (ses-name (unless (nrepl-server-p other-repl)\n                      (sesman-session-name-for-object 'CIDER other-repl))))\n     (thread-first\n       params\n       (cider--update-do-prompt)\n       (append other-params)\n       (plist-put :repl-init-function nil)\n       (plist-put :repl-type 'clj)\n       (plist-put :session-name ses-name)))))\n\n;;;###autoload\n(defun cider-connect-sibling-cljs (params &optional other-repl)\n  \"Create a ClojureScript REPL with the same server as OTHER-REPL.\nPARAMS is a plist optionally containing :cljs-repl-type (e.g. Node,\nFigwheel, etc).  All other parameters are inferred from the OTHER-REPL.\nOTHER-REPL defaults to `cider-current-repl' but in programs can also be a\nserver buffer, in which case a new session for that server is created.\"\n  (interactive \"P\")\n  (let* ((other-repl (or other-repl (cider-current-repl 'any 'ensure)))\n         (other-params (cider--gather-connect-params nil other-repl))\n         (ses-name (unless (nrepl-server-p other-repl)\n                     (sesman-session-name-for-object 'CIDER other-repl))))\n    (cider-nrepl-connect\n     (thread-first\n       params\n       (cider--update-do-prompt)\n       (append other-params)\n       (cider--update-cljs-type)\n       (cider--update-cljs-init-function)\n       (plist-put :session-name ses-name)\n       (plist-put :repl-type 'pending-cljs)))))\n\n;;;###autoload\n(defun cider-connect-clj (&optional params)\n  \"Initialize a Clojure connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port and :project-dir.  On\nprefix argument, prompt for all the parameters.\"\n  (interactive \"P\")\n  (cider-nrepl-connect\n   (thread-first\n     params\n     (cider--update-project-dir)\n     (cider--update-host-port)\n     (cider--check-existing-session)\n     (plist-put :repl-init-function nil)\n     (plist-put :session-name nil)\n     (plist-put :repl-type 'clj))))\n\n;;;###autoload\n(defun cider-connect-cljs (&optional params)\n  \"Initialize a ClojureScript connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port, :project-dir and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  On prefix, prompt for all the\nparameters regardless of their supplied or default values.\"\n  (interactive \"P\")\n  (cider-nrepl-connect\n   (thread-first\n     params\n     (cider--update-project-dir)\n     (cider--update-host-port)\n     (cider--check-existing-session)\n     (cider--update-cljs-type)\n     (cider--update-cljs-init-function)\n     (plist-put :session-name nil)\n     (plist-put :repl-type 'pending-cljs))))\n\n;;;###autoload\n(defun cider-connect-clj&cljs (params &optional soft-cljs-start)\n  \"Initialize a Clojure and ClojureScript connection to an nREPL server.\nPARAMS is a plist optionally containing :host, :port, :project-dir and\n:cljs-repl-type (e.g. Node, Figwheel, etc).  When SOFT-CLJS-START is\nnon-nil, don't start if ClojureScript requirements are not met.\"\n  (interactive \"P\")\n  (let* ((params (thread-first\n                   params\n                   (cider--update-project-dir)\n                   (cider--update-host-port)\n                   (cider--check-existing-session)\n                   (cider--update-cljs-type)))\n         (clj-repl (cider-connect-clj params)))\n    (if soft-cljs-start\n        (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error)\n          (cider-connect-sibling-cljs params clj-repl))\n      (cider-connect-sibling-cljs params clj-repl))))\n\n(defvar cider-connection-init-commands\n  '(cider-jack-in-clj\n    cider-jack-in-cljs\n    cider-jack-in-clj&cljs\n    cider-connect-clj\n    cider-connect-cljs\n    cider-connect-clj&cljs\n    cider-connect-sibling-clj\n    cider-connect-sibling-cljs)\n  \"A list of all user-level connection init commands in CIDER.\")\n\n;;;###autoload\n(defun cider ()\n  \"Start a connection of any type interactively.\"\n  (interactive)\n  (when-let* ((command (intern (completing-read \"Select command: \" cider-connection-init-commands))))\n    (call-interactively command)))\n\n\f\n;;; PARAMS updating\n\n(defun cider--update-do-prompt (params)\n  \"Update :do-prompt in PARAMS.\"\n  (cond ((equal params '(4)) (list :edit-jack-in-command t))\n        ((equal params '(16)) (list :do-prompt t))\n        (t params)))\n\n(defun cider--update-project-dir (params)\n  \"Update :project-dir in PARAMS.\"\n  (let* ((params (cider--update-do-prompt params))\n         (proj-dir (if (plist-get params :do-prompt)\n                       (read-directory-name \"Project: \"\n                                            (clojure-project-dir (cider-current-dir)))\n                     (plist-get params :project-dir)))\n         (orig-buffer (current-buffer)))\n    (if (or (null proj-dir)\n            (file-in-directory-p default-directory proj-dir))\n        (plist-put params :project-dir\n                   (or proj-dir\n                       (clojure-project-dir (cider-current-dir))))\n      ;; If proj-dir is not a parent of default-directory, transfer all local\n      ;; variables and hack dir-local variables into a temporary buffer and keep\n      ;; that buffer within `params` for the later use by other --update-\n      ;; functions. The context buffer should not be used outside of the param\n      ;; initialization pipeline. Therefore, we don't bother with making it\n      ;; unique or killing it anywhere.\n      (let ((context-buf-name \" *cider-context-buffer*\"))\n        (when (get-buffer context-buf-name)\n          (kill-buffer context-buf-name))\n        (with-current-buffer (get-buffer-create context-buf-name)\n          (dolist (pair (buffer-local-variables orig-buffer))\n            (pcase pair\n              (`(,name . ,value)        ;ignore unbound variables\n               (ignore-errors (set (make-local-variable name) value))))\n            (setq-local buffer-file-name nil))\n          (let ((default-directory proj-dir))\n            (hack-dir-local-variables-non-file-buffer)\n            (thread-first\n              params\n              (plist-put :project-dir proj-dir)\n              (plist-put :--context-buffer (current-buffer)))))))))\n\n(defun cider--update-cljs-type (params)\n  \"Update :cljs-repl-type in PARAMS.\"\n  (with-current-buffer (or (plist-get params :--context-buffer)\n                           (current-buffer))\n    (let ((params (cider--update-do-prompt params))\n          (inferred-type (or (plist-get params :cljs-repl-type)\n                             cider-default-cljs-repl)))\n      (plist-put params :cljs-repl-type\n                 (if (plist-get params :do-prompt)\n                     (cider-select-cljs-repl inferred-type)\n                   (or inferred-type\n                       (cider-select-cljs-repl)))))))\n\n(defcustom cider-edit-jack-in-command nil\n  \"When truthy allow the user to edit the command.\"\n  :type 'boolean\n  :safe #'booleanp\n  :version '(cider . \"0.22.0\"))\n\n(defvar cider--jack-in-nrepl-params-history nil\n  \"History list for user-specified jack-in nrepl command params.\")\n\n(defvar cider--jack-in-cmd-history nil\n  \"History list for user-specified jack-in commands.\")\n\n(defun cider--powershell-encode-command (cmd-params)\n  \"Base64 encode the powershell command and jack-in CMD-PARAMS for clojure-cli.\"\n  (let* ((quoted-params (replace-regexp-in-string \"\\\"\" \"\\\"\\\"\" cmd-params))\n         (command (format \"clojure %s\" quoted-params))\n         (utf-16le-command (encode-coding-string command 'utf-16le)))\n    (format \"-encodedCommand %s\" (base64-encode-string utf-16le-command t))))\n\n(defun cider--update-jack-in-cmd (params)\n  \"Update :jack-in-cmd key in PARAMS.\"\n  (let* ((params (cider--update-do-prompt params))\n         (project-dir (plist-get params :project-dir))\n         (project-type (cider-project-type project-dir))\n         (command (cider-jack-in-command project-type))\n         (command-resolved (cider-jack-in-resolve-command project-type))\n         (command-global-opts (cider-jack-in-global-options project-type))\n         (command-params (cider-jack-in-params project-type)))\n    (if command-resolved\n        (with-current-buffer (or (plist-get params :--context-buffer)\n                                 (current-buffer))\n          (let* ((command-params (if (plist-get params :do-prompt)\n                                     (read-string \"nREPL server command: \"\n                                                  command-params\n                                                  'cider--jack-in-nrepl-params-history)\n                                   command-params))\n                 (cmd-params (if cider-inject-dependencies-at-jack-in\n                                 (cider-inject-jack-in-dependencies command-global-opts command-params project-type)\n                               command-params)))\n            (if (or project-dir cider-allow-jack-in-without-project)\n                (when (or project-dir\n                          (eq cider-allow-jack-in-without-project t)\n                          (and (null project-dir)\n                               (eq cider-allow-jack-in-without-project 'warn)\n                               (y-or-n-p \"Are you sure you want to run `cider-jack-in' without a Clojure project? \")))\n                  (let ((cmd (format \"%s %s\" command-resolved (if (or (string-equal command \"powershell\")\n                                                                      (string-equal command \"pwsh\"))\n                                                                  (cider--powershell-encode-command cmd-params)\n                                                                cmd-params))))\n                    (plist-put params :jack-in-cmd (if (or cider-edit-jack-in-command\n                                                           (plist-get params :edit-jack-in-command))\n                                                       (read-string \"jack-in command: \" cmd 'cider--jack-in-cmd-history)\n                                                     cmd))))\n              (user-error \"`cider-jack-in' is not allowed without a Clojure project\"))))\n      (user-error \"The %s executable isn't on your `exec-path'\" command))))\n\n(defun cider--update-host-port (params)\n  \"Update :host and :port; or :socket-file in PARAMS.\"\n  (with-current-buffer (or (plist-get params :--context-buffer)\n                           (current-buffer))\n    (let* ((params (cider--update-do-prompt params))\n           (host (plist-get params :host))\n           (port (plist-get params :port))\n           (endpoint (if (plist-get params :do-prompt)\n                         (cider-select-endpoint)\n                       (if (and host port)\n                           (cons host port)\n                         (cider-select-endpoint)))))\n      (if (equal \"local-unix-domain-socket\" (car endpoint))\n          (plist-put params :socket-file (cdr endpoint))\n        (thread-first\n          params\n          (plist-put :host (car endpoint))\n          (plist-put :port (cdr endpoint)))))))\n\n(defun cider--update-cljs-init-function (params)\n  \"Update PARAMS :repl-init-function for cljs connections.\"\n  (with-current-buffer (or (plist-get params :--context-buffer)\n                           (current-buffer))\n    (let* ((cljs-type (plist-get params :cljs-repl-type))\n           (repl-init-form (cider-cljs-repl-form cljs-type)))\n      (thread-first\n        params\n        (plist-put :repl-init-function\n                   (lambda ()\n                     (cider--check-cljs cljs-type)\n                     ;; FIXME: ideally this should be done in the state handler\n                     (setq-local cider-cljs-repl-type cljs-type)\n                     (cider-nrepl-send-request\n                      (list \"op\" \"eval\"\n                            \"ns\" (cider-current-ns)\n                            \"code\" repl-init-form)\n                      (cider-repl-handler (current-buffer)))\n                     (when (and (buffer-live-p nrepl-server-buffer)\n                                cider-offer-to-open-cljs-app-in-browser)\n                       (cider--offer-to-open-app-in-browser nrepl-server-buffer))))\n        (plist-put :repl-init-form repl-init-form)))))\n\n(defun cider--check-existing-session (params)\n  \"Ask for confirmation if a session with similar PARAMS already exists.\nIf no session exists or user chose to proceed, return PARAMS.  If the user\ncanceled the action, signal quit.\"\n  (let* ((proj-dir (plist-get params :project-dir))\n         (host (plist-get params :host))\n         (port (plist-get params :port))\n         (session (seq-find (lambda (ses)\n                              (let ((ses-params (cider--gather-session-params ses)))\n                                (and (equal proj-dir (plist-get ses-params :project-dir))\n                                     (or (null port)\n                                         (equal port (plist-get ses-params :port)))\n                                     (or (null host)\n                                         (equal host (plist-get ses-params :host))))))\n                            (sesman-current-sessions 'CIDER '(project)))))\n    (when session\n      (unless (y-or-n-p\n               (concat\n                \"A CIDER session with the same connection parameters already exists (\" (car session) \").  \"\n                \"Are you sure you want to create a new session instead of using `cider-connect-sibling-clj(s)'?  \"))\n        (let ((debug-on-quit nil))\n          (signal 'quit nil)))))\n  params)\n\n\f\n;;; Aliases\n\n;;;###autoload\n(defalias 'cider-jack-in #'cider-jack-in-clj)\n;;;###autoload\n(defalias 'cider-connect #'cider-connect-clj)\n\n\f\n;;; Helpers\n\n(defun cider-current-host ()\n  \"Retrieve the current host.\"\n  (or (when (stringp buffer-file-name)\n        (file-remote-p buffer-file-name 'host))\n      \"localhost\"))\n\n(defun cider-select-endpoint ()\n  \"Interactively select the host and port to connect to.\"\n  (dolist (endpoint cider-known-endpoints)\n    (unless (stringp (or (nth 2 endpoint)\n                         (nth 1 endpoint)))\n      (user-error \"The port for %s in `cider-known-endpoints' should be a string\"\n                  (nth 0 endpoint))))\n  (let* ((ssh-hosts (cider--ssh-hosts))\n         (hosts (seq-uniq (append (when cider-host-history\n                                    ;; history elements are strings of the form \"host:port\"\n                                    (list (split-string (car cider-host-history) \":\")))\n                                  (list (list (cider-current-host)))\n                                  cider-known-endpoints\n                                  ssh-hosts\n                                  ;; always add localhost\n                                  '((\"localhost\")\n                                    (\"local-unix-domain-socket\")))))\n         (sel-host (cider--completing-read-host hosts))\n         (host (car sel-host))\n         (port (or (cadr sel-host)\n                   (if (equal host \"local-unix-domain-socket\")\n                       (cider--completing-read-socket-file)\n                     (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))))\n    (cons host port)))\n\n(defun cider--ssh-hosts ()\n  \"Retrieve all ssh host from local configuration files.\"\n  (seq-map (lambda (s) (list (replace-regexp-in-string \":$\" \"\" s)))\n           ;; `tramp-completion-mode' is obsoleted in 26\n           (cl-progv (if (version< emacs-version \"26\")\n                         '(tramp-completion-mode)\n                       '(non-essential)) '(t)\n             (tramp-completion-handle-file-name-all-completions \"\" \"/ssh:\"))))\n\n(defun cider--completing-read-host (hosts)\n  \"Interactively select host from HOSTS.\nEach element in HOSTS is one of: (host), (host port) or (label host port).\nReturn a list of the form (HOST PORT), where PORT can be nil.\"\n  (let* ((hosts (cider-join-into-alist hosts))\n         (sel-host (completing-read \"Host: \" hosts nil nil nil\n                                    'cider-host-history (caar hosts)))\n         (host (or (cdr (assoc sel-host hosts)) (list sel-host))))\n    ;; remove the label\n    (if (= 3 (length host)) (cdr host) host)))\n\n(defun cider--tramp-file-name (vec)\n  \"A simple compatibility wrapper around `make-tramp-file-name'.\nTramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC.\"\n  (if (version< emacs-version \"26.1\")\n      vec\n    (with-no-warnings\n      (make-tramp-file-name :method (elt vec 0)\n                            :host   (elt vec 2)))))\n\n(defcustom cider-infer-remote-nrepl-ports nil\n  \"When true, cider will use ssh to try to infer nREPL ports on remote hosts.\"\n  :type 'boolean\n  :safe #'booleanp\n  :package-version '(cider . \"0.19.0\"))\n\n(defun cider--infer-ports (host ssh-hosts)\n  \"Infer nREPL ports on HOST.\nReturn a list of elements of the form (directory port).  SSH-HOSTS is a list\nof remote SSH hosts.\"\n  (let ((localp (or (nrepl-local-host-p host)\n                    (not (assoc-string host ssh-hosts)))))\n    (if localp\n        ;; change dir: current file might be remote\n        (let* ((change-dir-p (file-remote-p default-directory))\n               (default-directory (if change-dir-p \"~/\" default-directory)))\n          (cider-locate-running-nrepl-ports (unless change-dir-p default-directory)))\n      (when cider-infer-remote-nrepl-ports\n        (let ((vec (vector \"sshx\" nil host \"\" nil))\n              ;; change dir: user might want to connect to a different remote\n              (dir (when (file-remote-p default-directory)\n                     (with-parsed-tramp-file-name default-directory cur\n                       (when (string= cur-host host) default-directory)))))\n          (tramp-maybe-open-connection (cider--tramp-file-name vec))\n          (with-current-buffer (tramp-get-connection-buffer (cider--tramp-file-name vec))\n            (cider-locate-running-nrepl-ports dir)))))))\n\n(defun cider--completing-read-port (host ports)\n  \"Interactively select port for HOST from PORTS.\"\n  (let* ((ports (cider-join-into-alist ports))\n         (sel-port (completing-read (format \"Port for %s: \" host) ports\n                                    nil nil nil nil (caar ports)))\n         (port (or (cdr (assoc sel-port ports)) sel-port))\n         (port (if (listp port) (cadr port) port)))\n    (if (stringp port) (string-to-number port) port)))\n\n(defun cider--completing-read-socket-file ()\n  \"Interactively select unix domain socket file name.\"\n  (read-file-name \"Socket File: \" nil nil t nil\n                  (lambda (filename)\n                    \"Predicate: auto-complete only socket-files and directories\"\n                    (let ((filetype (string-to-char\n                                     (file-attribute-modes\n                                      (file-attributes\n                                       filename)))))\n                      (or (eq ?s filetype)\n                          (eq ?d filetype))))))\n\n(defun cider-locate-running-nrepl-ports (&optional dir)\n  \"Locate ports of running nREPL servers.\nWhen DIR is non-nil also look for nREPL port files in DIR.  Return a list\nof list of the form (project-dir port).\"\n  (let* ((paths (cider--running-nrepl-paths))\n         (proj-ports (apply #'append\n                            (mapcar (lambda (d)\n                                      (mapcar (lambda (p) (list (file-name-nondirectory (directory-file-name d)) p))\n                                              (and d (nrepl-extract-ports (cider--file-path d)))))\n                                    (cons (clojure-project-dir dir) paths)))))\n    (seq-uniq (delq nil proj-ports))))\n\n(defun cider--running-nrepl-paths ()\n  \"Retrieve project paths of running nREPL servers.\nUse `cider-ps-running-nrepls-command' and\n`cider-ps-running-nrepl-path-regexp-list'.\"\n  (let (paths)\n    (with-temp-buffer\n      (insert (shell-command-to-string cider-ps-running-nrepls-command))\n      (dolist (regexp cider-ps-running-nrepl-path-regexp-list)\n        (goto-char 1)\n        (while (re-search-forward regexp nil t)\n          (setq paths (cons (match-string 1) paths)))))\n    (seq-uniq paths)))\n\n(defun cider--identify-buildtools-present (&optional project-dir)\n  \"Identify build systems present by their build files in PROJECT-DIR.\nPROJECT-DIR defaults to current project.\"\n  (let* ((default-directory (or project-dir (clojure-project-dir (cider-current-dir))))\n         (build-files '((lein        . \"project.clj\")\n                        (boot        . \"build.boot\")\n                        (clojure-cli . \"deps.edn\")\n                        (babashka    . \"bb.edn\")\n                        (shadow-cljs . \"shadow-cljs.edn\")\n                        (gradle      . \"build.gradle\")\n                        (gradle      . \"build.gradle.kts\"))))\n    (delq nil\n          (mapcar (lambda (candidate)\n                    (when (file-exists-p (cdr candidate))\n                      (car candidate)))\n                  build-files))))\n\n(defun cider-project-type (&optional project-dir)\n  \"Determine the type of the project in PROJECT-DIR.\nWhen multiple project file markers are present, check for a preferred build\ntool in `cider-preferred-build-tool', otherwise prompt the user to choose.\nPROJECT-DIR defaults to the current project.\"\n  (let* ((choices (cider--identify-buildtools-present project-dir))\n         (multiple-project-choices (> (length choices) 1))\n         ;; this needs to be a string to be used in `completing-read'\n         (default (symbol-name (car choices)))\n         ;; `cider-preferred-build-tool' used to be a string prior to CIDER\n         ;; 0.18, therefore the need for `cider-maybe-intern'\n         (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool)))\n    (cond ((and multiple-project-choices\n                (member preferred-build-tool choices))\n           preferred-build-tool)\n          (multiple-project-choices\n           (intern\n            (completing-read\n             (format \"Which command should be used (default %s): \" default)\n             choices nil t nil nil default)))\n          (choices\n           (car choices))\n          ;; TODO: Move this fallback outside the project-type check\n          ;; if we're outside a project we fallback to whatever tool\n          ;; is specified in `cider-jack-in-default' (normally clojure-cli)\n          ;; `cider-jack-in-default' used to be a string prior to CIDER\n          ;; 0.18, therefore the need for `cider-maybe-intern'\n          (t (cider-maybe-intern cider-jack-in-default)))))\n\n\n;; TODO: Implement a check for command presence over tramp\n(defun cider--resolve-command (command)\n  \"Find COMMAND in exec path (see variable `exec-path').\nReturn nil if not found.  In case `default-directory' is non-local we\nassume the command is available.\"\n  (when-let* ((command (or (and (file-remote-p default-directory) command)\n                           (executable-find command)\n                           (executable-find (concat command \".bat\")))))\n    (shell-quote-argument command)))\n\n(defun cider--resolve-project-command (command)\n  \"Find COMMAND in project dir or exec path (see variable `exec-path').\nIf COMMAND starts with ./ or ../ resolve relative to `clojure-project-dir',\notherwise resolve via `cider--resolve-command'.\"\n  (if (string-match-p \"\\\\`\\\\.\\\\{1,2\\\\}/\" command)\n      (locate-file command (list (clojure-project-dir)) '(\"\" \".bat\") 'executable)\n    (cider--resolve-command command)))\n\n(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration\n  \"The function to use to generate the message displayed on connect.\nWhen set to nil no additional message will be displayed.  A good\nalternative to the default is `cider-random-tip'.\"\n  :type 'function\n  :group 'cider\n  :package-version '(cider . \"0.11.0\"))\n\n(defun cider--maybe-inspire-on-connect ()\n  \"Display an inspiration connection message.\"\n  (when cider-connection-message-fn\n    (message \"Connected! %s\" (funcall cider-connection-message-fn))))\n\n(add-hook 'cider-connected-hook #'cider--maybe-inspire-on-connect)\n\n;;;###autoload\n(with-eval-after-load 'clojure-mode\n  (define-key clojure-mode-map (kbd \"C-c M-x\") #'cider)\n  (define-key clojure-mode-map (kbd \"C-c M-j\") #'cider-jack-in-clj)\n  (define-key clojure-mode-map (kbd \"C-c M-J\") #'cider-jack-in-cljs)\n  (define-key clojure-mode-map (kbd \"C-c M-c\") #'cider-connect-clj)\n  (define-key clojure-mode-map (kbd \"C-c M-C\") #'cider-connect-cljs)\n  (define-key clojure-mode-map (kbd \"C-c C-x\") 'cider-start-map)\n  (define-key clojure-mode-map (kbd \"C-c C-s\") 'sesman-map)\n  (require 'sesman)\n  (sesman-install-menu clojure-mode-map)\n  (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER))))\n\n(provide 'cider)\n\n;;; cider.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"nrepl-client.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52779508,"end":52779547},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52779547},"to":{"change":3,"start":52717630,"end":52717630},"introduced_by":3}],"inode":{"change":3,"pos":52717630}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52717630},"to":{"change":3,"start":52717631,"end":52779507},"introduced_by":3}],"inode":{"change":3,"pos":52717630}},"content":[{"Del":";;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \n;;         Reid McKenzie \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;; This file is not part of GNU Emacs.\n;;\n;;; Commentary:\n;;\n;; Provides an Emacs Lisp client to connect to Clojure nREPL servers.\n;;\n;; A connection is an abstract idea of the communication between Emacs (client)\n;; and nREPL server.  On the Emacs side connections are represented by two\n;; running processes.  The two processes are the server process and client\n;; process (the connection to the server).  Each of these is represented by its\n;; own process buffer, filter and sentinel.\n;;\n;; The nREPL communication process can be broadly represented as follows:\n;;\n;;    1) The server process is started as an Emacs subprocess (usually by\n;;       `cider-jack-in', which in turn fires up an nREPL server).  Note that\n;;       if a connection was established using `cider-connect' there won't be\n;;       a server process.\n;;\n;;    2) The server's process filter (`nrepl-server-filter') detects the\n;;       connection port from the first plain text response from the server and\n;;       starts a communication process (socket connection) as another Emacs\n;;       subprocess.  This is the nREPL client process (`nrepl-client-filter').\n;;       All requests and responses handling happens through this client\n;;       connection.\n;;\n;;    3) Requests are sent by `nrepl-send-request' and\n;;       `nrepl-send-sync-request'.  A request is simply a list containing a\n;;       requested operation name and the parameters required by the\n;;       operation.  Each request has an associated callback that is called once\n;;       the response for the request has arrived.  Besides the above functions\n;;       there are specialized request senders for each type of common\n;;       operations.  Examples are `nrepl-request:eval', `nrepl-request:clone',\n;;       `nrepl-sync-request:describe'.\n;;\n;;    4) Responses from the server are decoded in `nrepl-client-filter' and are\n;;       physically represented by alists whose structure depends on the type of\n;;       the response.  After having been decoded, the data from the response is\n;;       passed over to the callback that was registered by the original\n;;       request.\n;;\n;; Please see the comments in dedicated sections of this file for more detailed\n;; description.\n\n;;; Code:\n(require 'seq)\n(require 'subr-x)\n(require 'cl-lib)\n(require 'nrepl-dict)\n(require 'queue)\n(require 'sesman)\n(require 'tramp)\n\n\f\n;;; Custom\n\n(defgroup nrepl nil\n  \"Interaction with the Clojure nREPL Server.\"\n  :prefix \"nrepl-\"\n  :group 'applications)\n\n;; (defcustom nrepl-buffer-name-separator \" \"\n;;   \"Used in constructing the REPL buffer name.\n;; The `nrepl-buffer-name-separator' separates cider-repl from the project name.\"\n;;   :type '(string)\n;;   :group 'nrepl)\n(make-obsolete-variable 'nrepl-buffer-name-separator 'cider-session-name-template \"0.18\")\n\n;; (defcustom nrepl-buffer-name-show-port nil\n;;   \"Show the connection port in the nrepl REPL buffer name, if set to t.\"\n;;   :type 'boolean\n;;   :group 'nrepl)\n(make-obsolete-variable 'nrepl-buffer-name-show-port 'cider-session-name-template \"0.18\")\n\n(defcustom nrepl-connected-hook nil\n  \"List of functions to call when connecting to the nREPL server.\"\n  :type 'hook)\n\n(defcustom nrepl-disconnected-hook nil\n  \"List of functions to call when disconnected from the nREPL server.\"\n  :type 'hook)\n\n(defcustom nrepl-force-ssh-for-remote-hosts nil\n  \"If non-nil, do not attempt a direct connection for remote hosts.\"\n  :type 'boolean)\n\n(defcustom nrepl-use-ssh-fallback-for-remote-hosts nil\n  \"If non-nil, Use ssh as a fallback to connect to remote hosts.\nIt will attempt to connect via ssh to remote hosts when unable to connect\ndirectly.\"\n  :type 'boolean)\n\n(defcustom nrepl-sync-request-timeout 10\n  \"The number of seconds to wait for a sync response.\nSetting this to nil disables the timeout functionality.\"\n  :type 'integer)\n\n(defcustom nrepl-hide-special-buffers nil\n  \"Control the display of some special buffers in buffer switching commands.\nWhen true some special buffers like the server buffer will be hidden.\"\n  :type 'boolean)\n\n\f\n;;; Buffer Local Declarations\n\n;; These variables are used to track the state of nREPL connections\n(defvar-local nrepl-connection-buffer nil)\n(defvar-local nrepl-server-buffer nil)\n(defvar-local nrepl-messages-buffer nil)\n(defvar-local nrepl-endpoint nil)\n(defvar-local nrepl-project-dir nil)\n(defvar-local nrepl-is-server nil)\n(defvar-local nrepl-server-command nil)\n(defvar-local nrepl-tunnel-buffer nil)\n\n(defvar-local nrepl-session nil\n  \"Current nREPL session id.\")\n\n(defvar-local nrepl-tooling-session nil\n  \"Current nREPL tooling session id.\nTo be used for tooling calls (i.e. completion, eldoc, etc)\")\n\n(defvar-local nrepl-request-counter 0\n  \"Continuation serial number counter.\")\n\n(defvar-local nrepl-pending-requests nil)\n\n(defvar-local nrepl-completed-requests nil)\n\n(defvar-local nrepl-last-sync-response nil\n  \"Result of the last sync request.\")\n\n(defvar-local nrepl-last-sync-request-timestamp nil\n  \"The time when the last sync request was initiated.\")\n\n(defvar-local nrepl-ops nil\n  \"Available nREPL server ops (from describe).\")\n\n(defvar-local nrepl-versions nil\n  \"Version information received from the describe op.\")\n\n(defvar-local nrepl-aux nil\n  \"Auxiliary information received from the describe op.\")\n\n\f\n;;; nREPL Buffer Names\n\n(defconst nrepl-message-buffer-name-template \"*nrepl-messages %s(%r:%S)*\")\n(defconst nrepl-error-buffer-name \"*nrepl-error*\")\n(defconst nrepl-repl-buffer-name-template \"*cider-repl %s(%r:%S)*\")\n(defconst nrepl-server-buffer-name-template \"*nrepl-server %s*\")\n(defconst nrepl-tunnel-buffer-name-template \"*nrepl-tunnel %s*\")\n\n(declare-function cider-format-connection-params \"cider-connection\")\n(defun nrepl-make-buffer-name (template params &optional dup-ok)\n  \"Generate a buffer name using TEMPLATE and PARAMS.\nTEMPLATE and PARAMS are as in `cider-format-connection-params'.  If\noptional DUP-OK is non-nil, the returned buffer is not \\\"uniquified\\\" by a\ncall to `generate-new-buffer-name'.\"\n  (let ((name (cider-format-connection-params template params)))\n    (if dup-ok\n        name\n      (generate-new-buffer-name name))))\n\n(defun nrepl--make-hidden-name (buffer-name)\n  \"Apply a prefix to BUFFER-NAME that will hide the buffer.\"\n  (concat (if nrepl-hide-special-buffers \" \" \"\") buffer-name))\n\n(defun nrepl-repl-buffer-name (params &optional dup-ok)\n  \"Return the name of the repl buffer.\nPARAMS and DUP-OK are as in `nrepl-make-buffer-name'.\"\n  (nrepl-make-buffer-name nrepl-repl-buffer-name-template params dup-ok))\n\n(defun nrepl-server-buffer-name (params)\n  \"Return the name of the server buffer.\nPARAMS is as in `nrepl-make-buffer-name'.\"\n  (nrepl-make-buffer-name (nrepl--make-hidden-name nrepl-server-buffer-name-template)\n                          params))\n\n(defun nrepl-tunnel-buffer-name (params)\n  \"Return the name of the tunnel buffer.\nPARAMS is as in `nrepl-make-buffer-name'.\"\n  (nrepl-make-buffer-name (nrepl--make-hidden-name nrepl-tunnel-buffer-name-template)\n                          params))\n\n(defun nrepl-messages-buffer-name (params)\n  \"Return the name for the message buffer given connection PARAMS.\"\n  (nrepl-make-buffer-name nrepl-message-buffer-name-template params))\n\n\f\n;;; Utilities\n(defun nrepl-op-supported-p (op connection)\n  \"Return t iff the given operation OP is supported by the nREPL CONNECTION.\"\n  (when (buffer-live-p connection)\n    (with-current-buffer connection\n      (and nrepl-ops (nrepl-dict-get nrepl-ops op)))))\n\n(defun nrepl-aux-info (key connection)\n  \"Return KEY's aux info, as returned via the :describe op for CONNECTION.\"\n  (with-current-buffer connection\n    (and nrepl-aux (nrepl-dict-get nrepl-aux key))))\n\n(defun nrepl-local-host-p (host)\n  \"Return t if HOST is local.\"\n  (string-match-p tramp-local-host-regexp host))\n\n(defun nrepl-extract-port (dir)\n  \"Read port from applicable repl-port file in directory DIR.\"\n  (or (nrepl--port-from-file (expand-file-name \"repl-port\" dir))\n      (nrepl--port-from-file (expand-file-name \".nrepl-port\" dir))\n      (nrepl--port-from-file (expand-file-name \"target/repl-port\" dir))\n      (nrepl--port-from-file (expand-file-name \".shadow-cljs/nrepl.port\" dir))))\n\n(defun nrepl-extract-ports (dir)\n  \"Read ports from applicable repl-port files in directory DIR.\"\n  (delq nil\n        (list (nrepl--port-from-file (expand-file-name \"repl-port\" dir))\n              (nrepl--port-from-file (expand-file-name \".nrepl-port\" dir))\n              (nrepl--port-from-file (expand-file-name \"target/repl-port\" dir))\n              (nrepl--port-from-file (expand-file-name \".shadow-cljs/nrepl.port\" dir)))))\n\n(make-obsolete 'nrepl-extract-port 'nrepl-extract-ports \"1.5.0\")\n\n(defun nrepl--port-from-file (file)\n  \"Attempts to read port from a file named by FILE.\"\n  (when (file-exists-p file)\n    (with-temp-buffer\n      (insert-file-contents file)\n      (buffer-string))))\n\n\f\n;;; Bencode\n\n(cl-defstruct (nrepl-response-queue\n               (:include queue)\n               (:constructor nil)\n               (:constructor nrepl-response-queue (&optional stub)))\n  stub)\n\n(put 'nrepl-response-queue 'function-documentation\n     \"Create queue object used by nREPL to store decoded server responses.\nThe STUB slot stores a stack of nested, incompletely parsed objects.\")\n\n(defun nrepl--bdecode-list (&optional stack)\n  \"Decode a bencode list or dict starting at point.\nSTACK is as in `nrepl--bdecode-1'.\"\n  ;; skip leading l or d\n  (forward-char 1)\n  (let* ((istack (nrepl--bdecode-1 stack))\n         (pos0 (point))\n         (info (car istack)))\n    (while (null info)\n      (setq istack (nrepl--bdecode-1 (cdr istack))\n            pos0 (point)\n            info (car istack)))\n    (cond ((eq info :e)\n           (cons nil (cdr istack)))\n          ((eq info :stub)\n           (goto-char pos0)\n           istack)\n          (t istack))))\n\n(defun nrepl--bdecode-1 (&optional stack)\n  \"Decode one elementary bencode object starting at point.\nBencoded object is either list, dict, integer or string.  See\nhttp://en.wikipedia.org/wiki/Bencode#Encoding_algorithm for the encoding\nrules.\n\nSTACK is a list of so far decoded components of the current message.  Car\nof STACK is the innermost incompletely decoded object.  The algorithm pops\nthis list when inner object was completely decoded or grows it by one when\nnew list or dict was encountered.\n\nThe returned value is of the form (INFO . STACK) where INFO is\n:stub, nil, :end or :eob and STACK is either an incomplete parsing state as\nabove (INFO is :stub, nil or :eob) or a list of one component representing\nthe completely decoded message (INFO is :end).  INFO is nil when an\nelementary non-root object was successfully decoded.  INFO is :end when this\nobject is a root list or dict.\"\n  (cond\n   ;; list\n   ((eq (char-after) ?l)\n    (nrepl--bdecode-list (cons () stack)))\n   ;; dict\n   ((eq (char-after) ?d)\n    (nrepl--bdecode-list (cons '(dict) stack)))\n   ;; end of a list or a dict\n   ((eq (char-after) ?e)\n    (forward-char 1)\n    (cons (if (cdr stack) :e :end)\n          (nrepl--push (nrepl--nreverse (car stack))\n                       (cdr stack))))\n   ;; string\n   ((looking-at \"\\\\([0-9]+\\\\):\")\n    (let ((pos0 (point))\n          (beg (goto-char (match-end 0)))\n          (end (byte-to-position (+ (position-bytes (point))\n                                    (string-to-number (match-string 1))))))\n      (if (null end)\n          (progn (goto-char pos0)\n                 (cons :stub stack))\n        (goto-char end)\n        ;; normalise any platform-specific newlines\n        (let* ((original (buffer-substring-no-properties beg end))\n               (result (replace-regexp-in-string \"\\r\\n\\\\|\\n\\r\\\\|\\r\" \"\\n\" original)))\n          (cons nil (nrepl--push result stack))))))\n   ;; integer\n   ((looking-at \"i\\\\(-?[0-9]+\\\\)e\")\n    (goto-char (match-end 0))\n    (cons nil (nrepl--push (string-to-number (match-string 1))\n                           stack)))\n   ;; should happen in tests only as eobp is checked in nrepl-bdecode.\n   ((eobp)\n    (cons :eob stack))\n   ;; truncation in the middle of an integer or in 123: string prefix\n   ((looking-at-p \"[0-9i]\")\n    (cons :stub stack))\n   ;; else, throw a quiet error\n   (t\n    (message \"Invalid bencode message detected. See the %s buffer for details.\"\n             nrepl-error-buffer-name)\n    (nrepl-log-error\n     (format \"Decoder error at position %d (`%s'):\"\n             (point) (buffer-substring (point) (min (+ (point) 10) (point-max)))))\n    (nrepl-log-error (buffer-string))\n    (ding)\n    ;; Ensure loop break and clean queues' states in nrepl-bdecode:\n    (goto-char (point-max))\n    (cons :end nil))))\n\n(defun nrepl--bdecode-message (&optional stack)\n  \"Decode one full message starting at point.\nSTACK is as in `nrepl--bdecode-1'.  Return a cons (INFO . STACK).\"\n  (let* ((istack (nrepl--bdecode-1 stack))\n         (info (car istack))\n         (stack (cdr istack)))\n    (while (or (null info)\n               (eq info :e))\n      (setq istack (nrepl--bdecode-1 stack)\n            info (car istack)\n            stack (cdr istack)))\n    istack))\n\n(defun nrepl--ensure-fundamental-mode ()\n  \"Enable `fundamental-mode' if it is not enabled already.\"\n  (when (not (eq 'fundamental-mode major-mode))\n    (fundamental-mode)))\n\n(defun nrepl-bdecode (string-q &optional response-q)\n  \"Decode STRING-Q and place the results into RESPONSE-Q.\nSTRING-Q is either a queue of strings or a string.  RESPONSE-Q is a queue of\nserver requests (nREPL dicts).  STRING-Q and RESPONSE-Q are modified by side\neffects.\n\nReturn a cons (STRING-Q . RESPONSE-Q) where STRING-Q is the original queue\ncontaining the remainder of the input strings which could not be\ndecoded.  RESPONSE-Q is the original queue with successfully decoded messages\nenqueued and with slot STUB containing a nested stack of an incompletely\ndecoded message or nil if the strings were completely decoded.\"\n  (with-current-buffer (get-buffer-create \" *nrepl-decoding*\")\n    ;; Don't needlessly call `fundamental-mode', to prevent needlessly firing\n    ;; hooks. This fixes an issue with evil-mode where the cursor loses its\n    ;; correct color.\n    (nrepl--ensure-fundamental-mode)\n    (erase-buffer)\n    (if (queue-p string-q)\n        (while (queue-head string-q)\n          (insert (queue-dequeue string-q)))\n      (insert string-q)\n      (setq string-q (queue-create)))\n    (goto-char 1)\n    (unless response-q\n      (setq response-q (nrepl-response-queue)))\n    (let ((istack (nrepl--bdecode-message\n                   (nrepl-response-queue-stub response-q))))\n      (while (and (eq (car istack) :end)\n                  (not (eobp)))\n        (queue-enqueue response-q (cadr istack))\n        (setq istack (nrepl--bdecode-message)))\n      (unless (eobp)\n        (queue-enqueue string-q (buffer-substring (point) (point-max))))\n      (if (not (eq (car istack) :end))\n          (setf (nrepl-response-queue-stub response-q) (cdr istack))\n        (queue-enqueue response-q (cadr istack))\n        (setf (nrepl-response-queue-stub response-q) nil))\n      (erase-buffer)\n      (cons string-q response-q))))\n\n(defun nrepl-bencode (object)\n  \"Encode OBJECT with bencode.\nIntegers, lists and nrepl-dicts are treated according to bencode\nspecification.  Everything else is encoded as string.\"\n  (cond\n   ((integerp object) (format \"i%de\" object))\n   ((nrepl-dict-p object) (format \"d%se\" (mapconcat #'nrepl-bencode (cdr object) \"\")))\n   ((listp object) (format \"l%se\" (mapconcat #'nrepl-bencode object \"\")))\n   (t (format \"%s:%s\" (string-bytes object) object))))\n\n\f\n;;; Client: Process Filter\n\n(defvar nrepl-response-handler-functions nil\n  \"List of functions to call on each nREPL message.\nEach of these functions should be a function with one argument, which will\nbe called by `nrepl-client-filter' on every response received.  The current\nbuffer will be connection (REPL) buffer of the process.  These functions\nshould take a single argument, a dict representing the message.  See\n`nrepl--dispatch-response' for an example.\n\nThese functions are called before the message's own callbacks, so that they\ncan affect the behavior of the callbacks.  Errors signaled by these\nfunctions are demoted to messages, so that they don't prevent the\ncallbacks from running.\")\n\n(defun nrepl-client-filter (proc string)\n  \"Decode message(s) from PROC contained in STRING and dispatch them.\"\n  (let ((string-q (process-get proc :string-q)))\n    (queue-enqueue string-q string)\n    ;; Start decoding only if the last letter is 'e'\n    (when (eq ?e (aref string (1- (length string))))\n      (let ((response-q (process-get proc :response-q)))\n        (nrepl-bdecode string-q response-q)\n        (while (queue-head response-q)\n          (with-current-buffer (process-buffer proc)\n            (let ((response (queue-dequeue response-q)))\n              (with-demoted-errors \"Error in one of the `nrepl-response-handler-functions': %s\"\n                (run-hook-with-args 'nrepl-response-handler-functions response))\n              (nrepl--dispatch-response response))))))))\n\n(defun nrepl--dispatch-response (response)\n  \"Dispatch the RESPONSE to associated callback.\nFirst we check the callbacks of pending requests.  If no callback was found,\nwe check the completed requests, since responses could be received even for\nolder requests with \\\"done\\\" status.\"\n  (nrepl-dbind-response response (id)\n    (nrepl-log-message response 'response)\n    (let ((callback (or (gethash id nrepl-pending-requests)\n                        (gethash id nrepl-completed-requests))))\n      (if callback\n          (funcall callback response)\n        (error \"[nREPL] No response handler with id %s found\" id)))))\n\n(defun nrepl-client-sentinel (process message)\n  \"Handle sentinel events from PROCESS.\nNotify MESSAGE and if the process is closed run `nrepl-disconnected-hook'\nand kill the process buffer.\"\n  (if (string-match \"deleted\\\\b\" message)\n      (message \"[nREPL] Connection closed\")\n    (message \"[nREPL] Connection closed unexpectedly (%s)\"\n             (substring message 0 -1)))\n  (when (equal (process-status process) 'closed)\n    (when-let* ((client-buffer (process-buffer process)))\n      (sesman-remove-object 'CIDER nil client-buffer\n                            (not (process-get process :keep-server))\n                            'no-error)\n      (nrepl--clear-client-sessions client-buffer)\n      (with-current-buffer client-buffer\n        (goto-char (point-max))\n        (insert-before-markers\n         (propertize\n          (format \"\\n*** Closed on %s ***\\n\" (current-time-string))\n          'face 'cider-repl-stderr-face))\n        (run-hooks 'nrepl-disconnected-hook)\n        (let ((server-buffer nrepl-server-buffer))\n          (when (and (buffer-live-p server-buffer)\n                     (not (process-get process :keep-server)))\n            (setq nrepl-server-buffer nil)\n            (nrepl--maybe-kill-server-buffer server-buffer)))))))\n\n\f\n;;; Network\n\n(defun nrepl--unix-connect (socket-file &optional no-error)\n  \"If SOCKET-FILE is given, try to `make-network-process'.\nIf NO-ERROR is non-nil, show messages instead of throwing an error.\"\n  (if (not socket-file)\n      (unless no-error\n        (error \"[nREPL] Socket file not provided\"))\n    (message \"[nREPL] Establishing unix socket connection to %s ...\" socket-file)\n    (condition-case nil\n        (prog1 (list :proc (make-network-process :name \"nrepl-connection\" :buffer nil\n                                                 :family 'local :service socket-file)\n                     :host \"local-unix-domain-socket\"\n                     :port socket-file\n                     :socket-file socket-file)\n          (message \"[nREPL] Unix socket connection to %s established\" socket-file))\n      (error (let ((msg (format \"[nREPL] Unix socket connection to %s failed\" socket-file)))\n               (if no-error\n                   (message msg)\n                 (error msg))\n               nil)))))\n\n(defun nrepl-connect (host port)\n  \"Connect to the nREPL server identified by HOST and PORT.\nFor local hosts use a direct connection.  For remote hosts, if\n`nrepl-force-ssh-for-remote-hosts' is nil, attempt a direct connection\nfirst.  If `nrepl-force-ssh-for-remote-hosts' is non-nil or the direct\nconnection failed (and `nrepl-use-ssh-fallback-for-remote-hosts' is\nnon-nil), try to start a SSH tunneled connection.  Return a plist of the\nform (:proc PROC :host \\\"HOST\\\" :port PORT) that might contain additional\nkey-values depending on the connection type.\"\n  (let ((localp (if host\n                    (nrepl-local-host-p host)\n                  (not (file-remote-p default-directory)))))\n    (if localp\n        (nrepl--direct-connect (or host \"localhost\") port)\n      ;; we're dealing with a remote host\n      (if (and host (not nrepl-force-ssh-for-remote-hosts))\n          (or (nrepl--direct-connect host port 'no-error)\n              ;; direct connection failed\n              ;; fallback to ssh tunneling if enabled\n              (and nrepl-use-ssh-fallback-for-remote-hosts\n                   (message \"[nREPL] Falling back to SSH tunneled connection ...\")\n                   (nrepl--ssh-tunnel-connect host port))\n              ;; fallback is either not enabled or it failed as well\n              (if (and (null nrepl-use-ssh-fallback-for-remote-hosts)\n                       (not localp))\n                  (error \"[nREPL] Direct connection to %s:%s failed; try setting `nrepl-use-ssh-fallback-for-remote-hosts' to t\"\n                         host port)\n                (error \"[nREPL] Cannot connect to %s:%s\" host port)))\n        ;; `nrepl-force-ssh-for-remote-hosts' is non-nil\n        (nrepl--ssh-tunnel-connect host port)))))\n\n(defun nrepl--direct-connect (host port &optional no-error)\n  \"If HOST and PORT are given, try to `open-network-stream'.\nIf NO-ERROR is non-nil, show messages instead of throwing an error.\"\n  (if (not (and host port))\n      (unless no-error\n        (unless host\n          (error \"[nREPL] Host not provided\"))\n        (unless port\n          (error \"[nREPL] Port not provided\")))\n    (message \"[nREPL] Establishing direct connection to %s:%s ...\" host port)\n    (condition-case nil\n        (prog1 (list :proc (open-network-stream \"nrepl-connection\" nil host port)\n                     :host host :port port)\n          (message \"[nREPL] Direct connection to %s:%s established\" host port))\n      (error (let ((msg (format \"[nREPL] Direct connection to %s:%s failed\" host port)))\n               (if no-error\n                   (message msg)\n                 (error msg))\n               nil)))))\n\n(defun nrepl--ssh-tunnel-connect (host port)\n  \"Connect to a remote machine identified by HOST and PORT through SSH tunnel.\"\n  (message \"[nREPL] Establishing SSH tunneled connection to %s:%s ...\" host port)\n  (let* ((remote-dir (if host (format \"/ssh:%s:\" host) default-directory))\n         (ssh (or (executable-find \"ssh\")\n                  (error \"[nREPL] Cannot locate 'ssh' executable\")))\n         (cmd (nrepl--ssh-tunnel-command ssh remote-dir port))\n         (tunnel-buf (nrepl-tunnel-buffer-name\n                      `((:host ,host) (:port ,port))))\n         (tunnel (start-process-shell-command \"nrepl-tunnel\" tunnel-buf cmd)))\n    (process-put tunnel :waiting-for-port t)\n    (set-process-filter tunnel (nrepl--ssh-tunnel-filter port))\n    (while (and (process-live-p tunnel)\n                (process-get tunnel :waiting-for-port))\n      (accept-process-output nil 0.005))\n    (if (not (process-live-p tunnel))\n        (error \"[nREPL] SSH port forwarding failed.  Check the '%s' buffer\" tunnel-buf)\n      (message \"[nREPL] SSH port forwarding established to localhost:%s\" port)\n      (let ((endpoint (nrepl--direct-connect \"localhost\" port)))\n        (thread-first\n          endpoint\n          (plist-put :tunnel tunnel)\n          (plist-put :remote-host host))))))\n\n(defun nrepl--ssh-tunnel-command (ssh dir port)\n  \"Command string to open SSH tunnel to the host associated with DIR's PORT.\"\n  (with-parsed-tramp-file-name dir v\n    ;; this abuses the -v option for ssh to get output when the port\n    ;; forwarding is set up, which is used to synchronise on, so that\n    ;; the port forwarding is up when we try to connect.\n    (format-spec\n     \"%s -v -N -L %p:localhost:%p %u'%h'\"\n     `((?s . ,ssh)\n       (?p . ,port)\n       (?h . ,v-host)\n       (?u . ,(if v-user (format \"-l '%s' \" v-user) \"\"))))))\n\n(autoload 'comint-watch-for-password-prompt \"comint\"  \"(autoload).\")\n\n(defun nrepl--ssh-tunnel-filter (port)\n  \"Return a process filter that waits for PORT to appear in process output.\"\n  (let ((port-string (format \"LOCALHOST:%s\" port)))\n    (lambda (proc string)\n      (when (string-match-p port-string string)\n        (process-put proc :waiting-for-port nil))\n      (when (and (process-live-p proc)\n                 (buffer-live-p (process-buffer proc)))\n        (with-current-buffer (process-buffer proc)\n          (let ((moving (= (point) (process-mark proc))))\n            (save-excursion\n              (goto-char (process-mark proc))\n              (insert string)\n              (set-marker (process-mark proc) (point))\n              (comint-watch-for-password-prompt string))\n            (if moving (goto-char (process-mark proc)))))))))\n\n\f\n;;; Client: Process Handling\n\n(defun nrepl--kill-process (proc)\n  \"Kill PROC using the appropriate, os specific way.\nImplement a workaround to clean up an orphaned JVM process left around\nafter exiting the REPL on some windows machines.\"\n  (if (memq system-type '(cygwin windows-nt))\n      (interrupt-process proc)\n    (kill-process proc)))\n\n(defun nrepl-kill-server-buffer (server-buf)\n  \"Kill SERVER-BUF and its process.\"\n  (when (buffer-live-p server-buf)\n    (let ((proc (get-buffer-process server-buf)))\n      (when (process-live-p proc)\n        (set-process-query-on-exit-flag proc nil)\n        (nrepl--kill-process proc))\n      (kill-buffer server-buf))))\n\n(defun nrepl--maybe-kill-server-buffer (server-buf)\n  \"Kill SERVER-BUF and its process.\nDo not kill the server if there is a REPL connected to that server.\"\n  (when (buffer-live-p server-buf)\n    (with-current-buffer server-buf\n      ;; Don't kill if there is at least one REPL connected to it.\n      (when (not (seq-find (lambda (b)\n                             (eq (buffer-local-value 'nrepl-server-buffer b)\n                                 server-buf))\n                           (buffer-list)))\n        (nrepl-kill-server-buffer server-buf)))))\n\n(defun nrepl-start-client-process (&optional host port server-proc buffer-builder socket-file)\n  \"Create new client process identified by either HOST and PORT or SOCKET-FILE.\nIf SOCKET-FILE is non-nil, it takes precedence.  In remote buffers, HOST\nand PORT are taken from the current tramp connection.  SERVER-PROC must be\na running nREPL server process within Emacs.  BUFFER-BUILDER is a function\nof one argument (endpoint returned by `nrepl-connect') which returns a\nclient buffer.  Return the newly created client process.\"\n  (let* ((endpoint (if socket-file\n                       (nrepl--unix-connect (expand-file-name socket-file))\n                     (nrepl-connect host port)))\n         (client-proc (plist-get endpoint :proc))\n         (builder (or buffer-builder (error \"`buffer-builder' must be provided\")))\n         (client-buf (funcall builder endpoint)))\n\n    (set-process-buffer client-proc client-buf)\n\n    (set-process-filter client-proc #'nrepl-client-filter)\n    (set-process-sentinel client-proc #'nrepl-client-sentinel)\n    (set-process-coding-system client-proc 'utf-8-unix 'utf-8-unix)\n\n    (process-put client-proc :string-q (queue-create))\n    (process-put client-proc :response-q (nrepl-response-queue))\n\n    (with-current-buffer client-buf\n      (when-let* ((server-buf (and server-proc (process-buffer server-proc))))\n        (setq nrepl-project-dir (buffer-local-value 'nrepl-project-dir server-buf)\n              nrepl-server-buffer server-buf))\n      (setq nrepl-endpoint endpoint\n            nrepl-tunnel-buffer (when-let* ((tunnel (plist-get endpoint :tunnel)))\n                                  (process-buffer tunnel))\n            nrepl-pending-requests (make-hash-table :test 'equal)\n            nrepl-completed-requests (make-hash-table :test 'equal)))\n\n    (with-current-buffer client-buf\n      (nrepl--init-client-sessions client-proc)\n      (nrepl--init-capabilities client-buf)\n      (run-hooks 'nrepl-connected-hook))\n\n    client-proc))\n\n(defun nrepl--init-client-sessions (client)\n  \"Initialize CLIENT connection nREPL sessions.\nWe create two client nREPL sessions per connection - a main session and a\ntooling session.  The main session is general purpose and is used for pretty\nmuch every request that needs a session.  The tooling session is used only\nfor functionality that's implemented in terms of the \\\"eval\\\" op, so that\neval requests for functionality like pretty-printing won't clobber the\nvalues of *1, *2, etc.\"\n  (let* ((client-conn (process-buffer client))\n         (response-main (nrepl-sync-request:clone client-conn))\n         (response-tooling (nrepl-sync-request:clone client-conn t))) ; t for tooling\n    (nrepl-dbind-response response-main (new-session err)\n      (if new-session\n          (with-current-buffer client-conn\n            (setq nrepl-session new-session))\n        (error \"Could not create new session (%s)\" err)))\n    (nrepl-dbind-response response-tooling (new-session err)\n      (if new-session\n          (with-current-buffer client-conn\n            (setq nrepl-tooling-session new-session))\n        (error \"Could not create new tooling session (%s)\" err)))))\n\n(defun nrepl--init-capabilities (conn-buffer)\n  \"Store locally in CONN-BUFFER the capabilities of nREPL server.\"\n  (let ((description (nrepl-sync-request:describe conn-buffer)))\n    (nrepl-dbind-response description (ops versions aux)\n      (with-current-buffer conn-buffer\n        (setq nrepl-ops ops)\n        (setq nrepl-versions versions)\n        (setq nrepl-aux aux)))))\n\n(defun nrepl--clear-client-sessions (conn-buffer)\n  \"Clear information about nREPL sessions in CONN-BUFFER.\nCONN-BUFFER refers to a (presumably) dead connection,\nwhich we can eventually reuse.\"\n  (with-current-buffer conn-buffer\n    (setq nrepl-session nil)\n    (setq nrepl-tooling-session nil)))\n\n\f\n;;; Client: Response Handling\n;; After being decoded, responses (aka, messages from the server) are dispatched\n;; to handlers. Handlers are constructed with `nrepl-make-response-handler'.\n\n(defvar nrepl-err-handler nil\n  \"Evaluation error handler.\")\n\n(defun nrepl--mark-id-completed (id)\n  \"Move ID from `nrepl-pending-requests' to `nrepl-completed-requests'.\nIt is safe to call this function multiple times on the same ID.\"\n  ;; FIXME: This should go away eventually when we get rid of\n  ;; pending-request hash table\n  (when-let* ((handler (gethash id nrepl-pending-requests)))\n    (puthash id handler nrepl-completed-requests)\n    (remhash id nrepl-pending-requests)))\n\n(declare-function cider-repl--emit-interactive-output \"cider-repl\")\n(defun nrepl-notify (msg type)\n  \"Handle \\\"notification\\\" server request.\nMSG is a string to be displayed.  TYPE is the type of the message.  All\nnotifications are currently displayed with `message' function and emitted\nto the REPL.\"\n  (let* ((face (pcase type\n                 ((or \"message\" `nil) 'font-lock-builtin-face)\n                 (\"warning\" 'warning)\n                 (\"error\"   'error)))\n         (msg (if face\n                  (propertize msg 'face face)\n                (format \"%s: %s\" (upcase type) msg))))\n    (cider-repl--emit-interactive-output msg (or face 'font-lock-builtin-face))\n    (message msg)))\n\n(defvar cider-buffer-ns)\n(defvar cider-print-quota)\n(defvar cider-special-mode-truncate-lines)\n(declare-function cider-need-input \"cider-client\")\n(declare-function cider-set-buffer-ns \"cider-mode\")\n\n(defun nrepl-make-response-handler (buffer value-handler stdout-handler\n                                           stderr-handler done-handler\n                                           &optional eval-error-handler\n                                           content-type-handler\n                                           truncated-handler)\n  \"Make a response handler for connection BUFFER.\nA handler is a function that takes one argument - response received from\nthe server process.  The response is an alist that contains at least 'id'\nand 'session' keys.  Other standard response keys are 'value', 'out', 'err',\nand 'status'.\n\nThe presence of a particular key determines the type of the response.  For\nexample, if 'value' key is present, the response is of type 'value', if\n'out' key is present the response is 'stdout' etc.\n\nDepending on the type, the handler dispatches the appropriate value to one\nof the supplied handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER,\nDONE-HANDLER, EVAL-ERROR-HANDLER, CONTENT-TYPE-HANDLER, and\nTRUNCATED-HANDLER.\n\nHandlers are functions of the buffer and the value they handle, except for\nthe optional CONTENT-TYPE-HANDLER which should be a function of the buffer,\ncontent, the content-type to be handled as a list `(type attrs)'.\n\nIf the optional EVAL-ERROR-HANDLER is nil, the default `nrepl-err-handler'\nis used.  If any of the other supplied handlers are nil nothing happens for\nthe corresponding type of response.\"\n  (lambda (response)\n    (nrepl-dbind-response response (content-type content-transfer-encoding body\n                                                 value ns out err status id)\n      (when (buffer-live-p buffer)\n        (with-current-buffer buffer\n          (when (and ns (not (derived-mode-p 'clojure-mode)))\n            (cider-set-buffer-ns ns))))\n      (cond ((and content-type content-type-handler)\n             (funcall content-type-handler buffer\n                      (if (string= content-transfer-encoding \"base64\")\n                          (base64-decode-string body)\n                        body)\n                      content-type))\n            (value\n             (when value-handler\n               (funcall value-handler buffer value)))\n            (out\n             (when stdout-handler\n               (funcall stdout-handler buffer out)))\n            (err\n             (when stderr-handler\n               (funcall stderr-handler buffer err)))\n            (status\n             (when (and truncated-handler (member \"nrepl.middleware.print/truncated\" status))\n               (let ((warning (format \"\\n... output truncated to %sB ...\"\n                                      (file-size-human-readable cider-print-quota))))\n                 (funcall truncated-handler buffer warning)))\n             (when (member \"notification\" status)\n               (nrepl-dbind-response response (msg type)\n                 (nrepl-notify msg type)))\n             (when (member \"interrupted\" status)\n               (message \"Evaluation interrupted.\"))\n             (when (member \"eval-error\" status)\n               (funcall (or eval-error-handler nrepl-err-handler)))\n             (when (member \"namespace-not-found\" status)\n               (message \"Namespace `%s' not found.\" ns))\n             (when (member \"need-input\" status)\n               (cider-need-input buffer))\n             (when (member \"done\" status)\n               (nrepl--mark-id-completed id)\n               (when done-handler\n                 (funcall done-handler buffer))))))))\n\n\f\n;;; Client: Request Core API\n\n;; Requests are messages from an nREPL client (like CIDER) to an nREPL server.\n;; Requests can be asynchronous (sent with `nrepl-send-request') or\n;; synchronous (send with `nrepl-send-sync-request'). The request is a pair list\n;; of operation name and operation parameters. The core operations are described\n;; at https://github.com/nrepl/nrepl/blob/master/doc/ops.md. CIDER adds\n;; many more operations through nREPL middleware. See\n;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for\n;; the up-to-date list.\n\n(defun nrepl-next-request-id (connection)\n  \"Return the next request id for CONNECTION.\"\n  (with-current-buffer connection\n    (number-to-string (cl-incf nrepl-request-counter))))\n\n(defun nrepl-send-request (request callback connection &optional tooling)\n  \"Send REQUEST and register response handler CALLBACK using CONNECTION.\nREQUEST is a pair list of the form (\\\"op\\\" \\\"operation\\\" \\\"par1-name\\\"\n\\\"par1\\\" ... ). See the code of `nrepl-request:clone',\n`nrepl-request:stdin', etc. This expects that the REQUEST does not have a\nsession already in it. This code will add it as appropriate to prevent\nconnection/session drift.\nReturn the ID of the sent message.\nOptional argument TOOLING Set to t if desiring the tooling session rather than\nthe standard session.\"\n  (with-current-buffer connection\n    (when-let* ((session (if tooling nrepl-tooling-session nrepl-session)))\n      (setq request (append request `(\"session\" ,session))))\n    (let* ((id (nrepl-next-request-id connection))\n           (request (cons 'dict (lax-plist-put request \"id\" id)))\n           (message (nrepl-bencode request)))\n      (nrepl-log-message request 'request)\n      (puthash id callback nrepl-pending-requests)\n      (process-send-string nil message)\n      id)))\n\n(defvar nrepl-ongoing-sync-request nil\n  \"Dynamically bound to t while a sync request is ongoing.\")\n\n(declare-function cider-repl-emit-interactive-stderr \"cider-repl\")\n(declare-function cider--render-stacktrace-causes \"cider-eval\")\n\n(defun nrepl-send-sync-request (request connection &optional abort-on-input tooling)\n  \"Send REQUEST to the nREPL server synchronously using CONNECTION.\nHold till final \\\"done\\\" message has arrived and join all response messages\nof the same \\\"op\\\" that came along.\nIf ABORT-ON-INPUT is non-nil, the function will return nil at the first\nsign of user input, so as not to hang the interface.\nIf TOOLING, use the tooling session rather than the standard session.\"\n  (let* ((time0 (current-time))\n         (response (cons 'dict nil))\n         (nrepl-ongoing-sync-request t)\n         status)\n    (nrepl-send-request request\n                        (lambda (resp) (nrepl--merge response resp))\n                        connection\n                        tooling)\n    (while (and (not (member \"done\" status))\n                (not (and abort-on-input\n                          (input-pending-p))))\n      (setq status (nrepl-dict-get response \"status\"))\n      ;; If we get a need-input message then the repl probably isn't going\n      ;; anywhere, and we'll just timeout. So we forward it to the user.\n      (if (member \"need-input\" status)\n          (progn (cider-need-input (current-buffer))\n                 ;; If the used took a few seconds to respond, we might\n                 ;; unnecessarily timeout, so let's reset the timer.\n                 (setq time0 (current-time)))\n        ;; break out in case we don't receive a response for a while\n        (when (and nrepl-sync-request-timeout\n                   (time-less-p\n                    nrepl-sync-request-timeout\n                    (time-subtract nil time0)))\n          (error \"Sync nREPL request timed out %s\" request)))\n      ;; Clean up the response, otherwise we might repeatedly ask for input.\n      (nrepl-dict-put response \"status\" (remove \"need-input\" status))\n      (accept-process-output nil 0.01))\n    ;; If we couldn't finish, return nil.\n    (when (member \"done\" status)\n      (nrepl-dbind-response response (ex err eval-error pp-stacktrace id)\n        (when (and ex err)\n          (cond (eval-error (funcall nrepl-err-handler))\n                (pp-stacktrace (cider--render-stacktrace-causes\n                                pp-stacktrace (remove \"done\" status))))) ;; send the error type\n        (when id\n          (with-current-buffer connection\n            (nrepl--mark-id-completed id)))\n        response))))\n\n(defun nrepl-request:stdin (input callback connection)\n  \"Send a :stdin request with INPUT using CONNECTION.\nRegister CALLBACK as the response handler.\"\n  (nrepl-send-request `(\"op\" \"stdin\"\n                        \"stdin\" ,input)\n                      callback\n                      connection))\n\n(defun nrepl-request:interrupt (pending-request-id callback connection)\n  \"Send an :interrupt request for PENDING-REQUEST-ID.\nThe request is dispatched using CONNECTION.\nRegister CALLBACK as the response handler.\"\n  (nrepl-send-request `(\"op\" \"interrupt\"\n                        \"interrupt-id\" ,pending-request-id)\n                      callback\n                      connection))\n\n(define-minor-mode cider-enlighten-mode nil\n  :lighter (cider-mode \" light\")\n  :global t)\n\n(defun nrepl--eval-request (input &optional ns line column)\n  \"Prepare :eval request message for INPUT.\nNS provides context for the request.\nIf LINE and COLUMN are non-nil and current buffer is a file buffer, \\\"line\\\",\n\\\"column\\\" and \\\"file\\\" are added to the message.\"\n  (nconc (and ns `(\"ns\" ,ns))\n         `(\"op\" \"eval\"\n           \"code\" ,(substring-no-properties input))\n         (when cider-enlighten-mode\n           '(\"enlighten\" \"true\"))\n         (let ((file (or (buffer-file-name) (buffer-name))))\n           (when (and line column file)\n             `(\"file\" ,file\n               \"line\" ,line\n               \"column\" ,column)))))\n\n(defun nrepl-request:eval (input callback connection &optional ns line column additional-params tooling)\n  \"Send the request INPUT and register the CALLBACK as the response handler.\nThe request is dispatched via CONNECTION.  If NS is non-nil,\ninclude it in the request.  LINE and COLUMN, if non-nil, define the position\nof INPUT in its buffer.  A CONNECTION uniquely determines two connections\navailable: the standard interaction one and the tooling session.  If the\ntooling is desired, set TOOLING to true.\nADDITIONAL-PARAMS is a plist to be appended to the request message.\"\n  (nrepl-send-request (append (nrepl--eval-request input ns line column) additional-params)\n                      callback\n                      connection\n                      tooling))\n\n(defun nrepl-sync-request:clone (connection &optional tooling)\n  \"Sent a :clone request to create a new client session.\nThe request is dispatched via CONNECTION.\nOptional argument TOOLING Tooling is set to t if wanting the tooling session\nfrom CONNECTION.\"\n  (nrepl-send-sync-request '(\"op\" \"clone\")\n                           connection\n                           nil tooling))\n\n(defun nrepl-sync-request:close (connection)\n  \"Sent a :close request to close CONNECTION's SESSION.\"\n  (nrepl-send-sync-request '(\"op\" \"close\") connection)\n  (nrepl-send-sync-request '(\"op\" \"close\") connection nil t)) ;; close tooling session\n\n(defun nrepl-sync-request:describe (connection)\n  \"Perform :describe request for CONNECTION and SESSION.\"\n  (nrepl-send-sync-request '(\"op\" \"describe\")\n                           connection))\n\n(defun nrepl-sync-request:ls-sessions (connection)\n  \"Perform :ls-sessions request for CONNECTION.\"\n  (nrepl-send-sync-request '(\"op\" \"ls-sessions\") connection))\n\n(defun nrepl-sync-request:ls-middleware (connection)\n  \"Perform :ls-middleware request for CONNECTION.\"\n  (nrepl-send-sync-request '(\"op\" \"ls-middleware\") connection))\n\n(defun nrepl-sync-request:eval (input connection &optional ns tooling)\n  \"Send the INPUT to the nREPL server synchronously.\nThe request is dispatched via CONNECTION.\nIf NS is non-nil, include it in the request\nIf TOOLING is non-nil the evaluation is done using the tooling nREPL\nsession.\"\n  (nrepl-send-sync-request\n   (nrepl--eval-request input ns)\n   connection\n   nil\n   tooling))\n\n(defun nrepl-sessions (connection)\n  \"Get a list of active sessions on the nREPL server using CONNECTION.\"\n  (nrepl-dict-get (nrepl-sync-request:ls-sessions connection) \"sessions\"))\n\n(defun nrepl-middleware (connection)\n  \"Get a list of middleware on the nREPL server using CONNECTION.\"\n  (nrepl-dict-get (nrepl-sync-request:ls-middleware connection) \"middleware\"))\n\n\f\n;;; Server\n\n;; The server side process is started by `nrepl-start-server-process' and has a\n;; very simple filter that pipes its output directly into its process buffer\n;; (*nrepl-server*). The main purpose of this process is to start the actual\n;; nrepl communication client (`nrepl-client-filter') when the message \"nREPL\n;; server started on port ...\" is detected.\n\n;; internal variables used for state transfer between nrepl-start-server-process\n;; and nrepl-server-filter.\n(defvar-local nrepl-on-port-callback nil)\n\n(defun nrepl-server-p (buffer-or-process)\n  \"Return t if BUFFER-OR-PROCESS is an nREPL server.\"\n  (let ((buffer (if (processp buffer-or-process)\n                    (process-buffer buffer-or-process)\n                  buffer-or-process)))\n    (buffer-local-value 'nrepl-is-server buffer)))\n\n(defun nrepl-start-server-process (directory cmd on-port-callback)\n  \"Start nREPL server process in DIRECTORY using shell command CMD.\nReturn a newly created process.  Set `nrepl-server-filter' as the process\nfilter, which starts REPL process with its own buffer once the server has\nstarted.  ON-PORT-CALLBACK is a function of one argument (server buffer)\nwhich is called by the process filter once the port of the connection has\nbeen determined.\"\n  (let* ((default-directory (or directory default-directory))\n         (serv-buf (get-buffer-create\n                    (nrepl-server-buffer-name\n                     `(:project-dir ,default-directory)))))\n    (with-current-buffer serv-buf\n      (setq nrepl-is-server t\n            nrepl-project-dir default-directory\n            nrepl-server-command cmd\n            nrepl-on-port-callback on-port-callback))\n    (let ((serv-proc (start-file-process-shell-command\n                      \"nrepl-server\" serv-buf cmd)))\n      (set-process-filter serv-proc #'nrepl-server-filter)\n      (set-process-sentinel serv-proc #'nrepl-server-sentinel)\n      (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix)\n      (message \"[nREPL] Starting server via %s\"\n               (propertize cmd 'face 'font-lock-keyword-face))\n      serv-proc)))\n\n(defconst nrepl-listening-address-regexp\n  (rx (or\n       ;; standard\n       (and \"nREPL server started on port \" (group-n 1 (+ (any \"0-9\"))))\n       ;; babashka\n       (and \"Started nREPL server at \"\n            (group-n 2 (+? any)) \":\" (group-n 1 (+ (any \"0-9\"))))))\n  \"A regexp to search an nREPL's stdout for the address it is listening on.\n\nIf it matches, the address components can be extracted using the following\nmatch groups:\n1  for the port, and\n2  for the host (babashka only).\")\n\n(defun nrepl-server-filter (process output)\n  \"Process nREPL server output from PROCESS contained in OUTPUT.\"\n  ;; In Windows this can be false:\n  (let ((server-buffer (process-buffer process)))\n    (when (buffer-live-p server-buffer)\n      (with-current-buffer server-buffer\n        ;; auto-scroll on new output\n        (let ((moving (= (point) (process-mark process))))\n          (save-excursion\n            (goto-char (process-mark process))\n            (insert output)\n            (ansi-color-apply-on-region (process-mark process) (point))\n            (set-marker (process-mark process) (point)))\n          (when moving\n            (goto-char (process-mark process))\n            (when-let* ((win (get-buffer-window)))\n              (set-window-point win (point)))))\n        ;; detect the port the server is listening on from its output\n        (when (and (null nrepl-endpoint)\n                   (string-match nrepl-listening-address-regexp output))\n          (let ((host (or (match-string 2 output)\n                          (file-remote-p default-directory 'host)\n                          \"localhost\"))\n                (port (string-to-number (match-string 1 output))))\n            (setq nrepl-endpoint (list :host host\n                                       :port port))\n            (message \"[nREPL] server started on %s\" port)\n            (when nrepl-on-port-callback\n              (funcall nrepl-on-port-callback (process-buffer process)))))))))\n\n(defmacro emacs-bug-46284/when-27.1-windows-nt (&rest body)\n  \"Only evaluate BODY when Emacs bug #46284 has been detected.\"\n  (when (and (eq system-type 'windows-nt)\n             (string= emacs-version \"27.1\"))\n    (cons 'progn body)))\n\n\n(declare-function cider--close-connection \"cider-connection\")\n(defun nrepl-server-sentinel (process event)\n  \"Handle nREPL server PROCESS EVENT.\"\n  (let* ((server-buffer (process-buffer process))\n         (clients (seq-filter (lambda (b)\n                                (eq (buffer-local-value 'nrepl-server-buffer b)\n                                    server-buffer))\n                              (buffer-list)))\n         (problem (if (and server-buffer (buffer-live-p server-buffer))\n                      (with-current-buffer server-buffer\n                        (buffer-substring (point-min) (point-max)))\n                    \"\")))\n    (emacs-bug-46284/when-27.1-windows-nt\n     ;; There is a bug in emacs 27.1 (since fixed) that sets all EVENT\n     ;; descriptions for signals to \"unknown signal\". We correct this by\n     ;; resetting it back to its canonical value.\n     (when (eq (process-status process) 'signal)\n       (cl-case (process-exit-status process)\n         ;; SIGHUP==1 emacs nt/inc/ms-w32.h\n         (1 (setq event \"Hangup\"))\n         ;; SIGINT==2 x86_64-w64-mingw32/include/signal.h\n         (2 (setq event \"Interrupt\"))\n         ;; SIGKILL==9 emacs nt/inc/ms-w32.h\n         (9 (setq event \"Killed\")))))\n\n    (when server-buffer\n      (kill-buffer server-buffer))\n    (cond\n     ((string-match-p \"^killed\\\\|^interrupt\" event)\n      nil)\n     ((string-match-p \"^hangup\" event)\n      (mapc #'cider--close-connection clients))\n     ;; On Windows, a failed start sends the \"finished\" event. On Linux it sends\n     ;; \"exited abnormally with code 1\".\n     (t (error \"Could not start nREPL server: %s\" problem)))))\n\n\f\n;;; Messages\n\n(defcustom nrepl-log-messages nil\n  \"If non-nil, log protocol messages to an nREPL messages buffer.\nThis is extremely useful for debug purposes, as it allows you to inspect\nthe communication between Emacs and an nREPL server.  Enabling the logging\nmight have a negative impact on performance, so it's not recommended to\nkeep it enabled unless you need to debug something.\"\n  :type 'boolean\n  :safe #'booleanp)\n\n(defconst nrepl-message-buffer-max-size 1000000\n  \"Maximum size for the nREPL message buffer.\nDefaults to 1000000 characters, which should be an insignificant\nmemory burden, while providing reasonable history.\")\n\n(defconst nrepl-message-buffer-reduce-denominator 4\n  \"Divisor by which to reduce message buffer size.\nWhen the maximum size for the nREPL message buffer is exceeded, the size of\nthe buffer is reduced by one over this value.  Defaults to 4, so that 1/4\nof the buffer is removed, which should ensure the buffer's maximum is\nreasonably utilized, while limiting the number of buffer shrinking\noperations.\")\n\n(defvar nrepl-messages-mode-map\n  (let ((map (make-sparse-keymap)))\n    (define-key map (kbd \"n\")   #'next-line)\n    (define-key map (kbd \"p\")   #'previous-line)\n    (define-key map (kbd \"TAB\") #'forward-button)\n    (define-key map (kbd \"RET\") #'nrepl-log-expand-button)\n    (define-key map (kbd \"e\")   #'nrepl-log-expand-button)\n    (define-key map (kbd \"E\")   #'nrepl-log-expand-all-buttons)\n    (define-key map (kbd \"\") #'backward-button)\n    map))\n\n(define-derived-mode nrepl-messages-mode special-mode \"nREPL Messages\"\n  \"Major mode for displaying nREPL messages.\n\n\\\\{nrepl-messages-mode-map}\"\n  (when cider-special-mode-truncate-lines\n    (setq-local truncate-lines t))\n  (setq-local sesman-system 'CIDER)\n  (setq-local electric-indent-chars nil)\n  (setq-local comment-start \";\")\n  (setq-local comment-end \"\")\n  (setq-local paragraph-start \"(-->\\\\|(<--\")\n  (setq-local paragraph-separate \"(<--\"))\n\n(defun nrepl-decorate-msg (msg type)\n  \"Decorate nREPL MSG according to its TYPE.\"\n  (pcase type\n    (`request (cons '--> (cdr msg)))\n    (`response (cons '<-- (cdr msg)))))\n\n(defun nrepl-log-message (msg type)\n  \"Log the nREPL MSG.\nTYPE is either request or response.  The message is logged to a buffer\ndescribed by `nrepl-message-buffer-name-template'.\"\n  (when nrepl-log-messages\n    ;; append a time-stamp to the message before logging it\n    ;; the time-stamps are quite useful for debugging\n    (setq msg (cons (car msg)\n                    (lax-plist-put (cdr msg) \"time-stamp\"\n                                   (format-time-string \"%Y-%m-%0d %H:%M:%S.%N\"))))\n    (with-current-buffer (nrepl-messages-buffer (current-buffer))\n      (setq buffer-read-only nil)\n      (when (> (buffer-size) nrepl-message-buffer-max-size)\n        (goto-char (/ (buffer-size) nrepl-message-buffer-reduce-denominator))\n        (re-search-forward \"^(\" nil t)\n        (delete-region (point-min) (- (point) 1)))\n      (goto-char (point-max))\n      (nrepl-log-pp-object (nrepl-decorate-msg msg type)\n                           (nrepl-log--message-color (lax-plist-get (cdr msg) \"id\"))\n                           t)\n      (when-let* ((win (get-buffer-window)))\n        (set-window-point win (point-max)))\n      (setq buffer-read-only t))))\n\n(defun nrepl-toggle-message-logging ()\n  \"Toggle the value of `nrepl-log-messages' between nil and t.\n\nThis in effect enables or disables the logging of nREPL messages.\"\n  (interactive)\n  (setq nrepl-log-messages (not nrepl-log-messages))\n  (if nrepl-log-messages\n      (message \"nREPL message logging enabled\")\n    (message \"nREPL message logging disabled\")))\n\n(defcustom nrepl-message-colors\n  '(\"red\" \"brown\" \"coral\" \"orange\" \"green\" \"deep sky blue\" \"blue\" \"dark violet\")\n  \"Colors used in the messages buffer.\"\n  :type '(repeat color))\n\n(defun nrepl-log-expand-button (&optional button)\n  \"Expand the objects hidden in BUTTON's :nrepl-object property.\nBUTTON defaults the button at point.\"\n  (interactive)\n  (if-let* ((button (or button (button-at (point)))))\n      (let* ((start (overlay-start button))\n             (end   (overlay-end   button))\n             (obj   (overlay-get button :nrepl-object))\n             (inhibit-read-only t))\n        (save-excursion\n          (goto-char start)\n          (delete-overlay button)\n          (delete-region start end)\n          (nrepl-log-pp-object obj)\n          (delete-char -1)))\n    (error \"No button at point\")))\n\n(defun nrepl-log-expand-all-buttons ()\n  \"Expand all buttons in nREPL log buffer.\"\n  (interactive)\n  (if (not (eq major-mode 'nrepl-messages-mode))\n      (user-error \"Not in a `nrepl-messages-mode'\")\n    (save-excursion\n      (let* ((pos (point-min))\n             (button (next-button pos)))\n        (while button\n          (setq pos (overlay-start button))\n          (nrepl-log-expand-button button)\n          (setq button (next-button pos)))))))\n\n(defun nrepl-log--expand-button-mouse (event)\n  \"Expand the text hidden under overlay button.\nEVENT gives the button position on window.\"\n  (interactive \"e\")\n  (pcase (elt event 1)\n    (`(,window ,_ ,_ ,_ ,_ ,point . ,_)\n     (with-selected-window window\n       (nrepl-log-expand-button (button-at point))))))\n\n(defun nrepl-log-insert-button (label object)\n  \"Insert button with LABEL and :nrepl-object property as OBJECT.\"\n  (insert-button label\n                 :nrepl-object object\n                 'action #'nrepl-log-expand-button\n                 'face 'link\n                 'help-echo \"RET: Expand object.\"\n                 ;; Workaround for bug#1568 (don't use local-map here; it\n                 ;; overwrites major mode map.)\n                 'keymap `(keymap (mouse-1 . nrepl-log--expand-button-mouse)))\n  (insert \"\\n\"))\n\n(defun nrepl-log--message-color (id)\n  \"Return the color to use when pretty-printing the nREPL message with ID.\nIf ID is nil, return nil.\"\n  (when id\n    (thread-first\n      (string-to-number id)\n      (mod (length nrepl-message-colors))\n      (nth nrepl-message-colors))))\n\n(defun nrepl-log--pp-listlike (object &optional foreground button)\n  \"Pretty print nREPL list like OBJECT.\nFOREGROUND and BUTTON are as in `nrepl-log-pp-object'.\"\n  (cl-flet ((color (str)\n                   (propertize str 'face\n                               (append '(:weight ultra-bold)\n                                       (when foreground `(:foreground ,foreground))))))\n    (let ((head (format \"(%s\" (car object))))\n      (insert (color head))\n      (if (null (cdr object))\n          (insert \")\\n\")\n        (let* ((indent (+ 2 (- (current-column) (length head))))\n               (sorted-pairs (sort (seq-partition (cl-copy-list (cdr object)) 2)\n                                   (lambda (a b)\n                                     (string< (car a) (car b)))))\n               (name-lengths (seq-map (lambda (pair) (length (car pair))) sorted-pairs))\n               (longest-name (seq-max name-lengths))\n               ;; Special entries are displayed first\n               (specialq (lambda (pair) (member (car pair) '(\"id\" \"op\" \"session\" \"time-stamp\"))))\n               (special-pairs (seq-filter specialq sorted-pairs))\n               (not-special-pairs (seq-remove specialq sorted-pairs))\n               (all-pairs (seq-concatenate 'list special-pairs not-special-pairs))\n               (sorted-object (apply #'seq-concatenate 'list all-pairs)))\n          (insert \"\\n\")\n          (cl-loop for l on sorted-object by #'cddr\n                   do (let ((indent-str (make-string indent ?\\s))\n                            (name-str (propertize (car l) 'face\n                                                  ;; Only highlight top-level keys.\n                                                  (unless (eq (car object) 'dict)\n                                                    'font-lock-keyword-face)))\n                            (spaces-str (make-string (- longest-name (length (car l))) ?\\s)))\n                        (insert (format \"%s%s%s \" indent-str name-str spaces-str))\n                        (nrepl-log-pp-object (cadr l) nil button)))\n          (when (eq (car object) 'dict)\n            (delete-char -1))\n          (insert (color \")\\n\")))))))\n\n(defun nrepl-log-pp-object (object &optional foreground button)\n  \"Pretty print nREPL OBJECT, delimited using FOREGROUND.\nIf BUTTON is non-nil, try making a button from OBJECT instead of inserting\nit into the buffer.\"\n  (let ((min-dict-fold-size   1)\n        (min-list-fold-size   10)\n        (min-string-fold-size 60))\n    (if-let* ((head (car-safe object)))\n        ;; list-like objects\n        (cond\n         ;; top level dicts (always expanded)\n         ((memq head '(<-- -->))\n          (nrepl-log--pp-listlike object foreground button))\n         ;; inner dicts\n         ((eq head 'dict)\n          (if (and button (> (length object) min-dict-fold-size))\n              (nrepl-log-insert-button \"(dict ...)\" object)\n            (nrepl-log--pp-listlike object foreground button)))\n         ;; lists\n         (t\n          (if (and button (> (length object) min-list-fold-size))\n              (nrepl-log-insert-button (format \"(%s ...)\" (prin1-to-string head)) object)\n            (pp object (current-buffer)))))\n      ;; non-list objects\n      (if (stringp object)\n          (if (and button (> (length object) min-string-fold-size))\n              (nrepl-log-insert-button (format \"\\\"%s...\\\"\" (substring object 0 min-string-fold-size)) object)\n            (insert (prin1-to-string object) \"\\n\"))\n        (pp object (current-buffer))\n        (insert \"\\n\")))))\n\n(declare-function cider--gather-connect-params \"cider-connection\")\n(defun nrepl-messages-buffer (conn)\n  \"Return or create the buffer for CONN.\nThe default buffer name is *nrepl-messages connection*.\"\n  (with-current-buffer conn\n    (or (and (buffer-live-p nrepl-messages-buffer)\n             nrepl-messages-buffer)\n        (setq nrepl-messages-buffer\n              (let ((buffer (get-buffer-create\n                             (nrepl-messages-buffer-name\n                              (cider--gather-connect-params)))))\n                (with-current-buffer buffer\n                  (buffer-disable-undo)\n                  (nrepl-messages-mode)\n                  buffer))))))\n\n(defun nrepl-error-buffer ()\n  \"Return or create the buffer.\nThe default buffer name is *nrepl-error*.\"\n  (or (get-buffer nrepl-error-buffer-name)\n      (let ((buffer (get-buffer-create nrepl-error-buffer-name)))\n        (with-current-buffer buffer\n          (buffer-disable-undo)\n          (nrepl--ensure-fundamental-mode)\n          buffer))))\n\n(defun nrepl-log-error (msg)\n  \"Log the given MSG to the buffer given by `nrepl-error-buffer'.\"\n  (with-current-buffer (nrepl-error-buffer)\n    (setq buffer-read-only nil)\n    (goto-char (point-max))\n    (insert msg)\n    (when-let* ((win (get-buffer-window)))\n      (set-window-point win (point-max)))\n    (setq buffer-read-only t)))\n\n(make-obsolete 'nrepl-default-client-buffer-builder nil \"0.18\")\n\n(provide 'nrepl-client)\n\n;;; nrepl-client.el ends here\n"}]}},{"FileDel":{"deleted_names":[{"basename":"nrepl-dict.el","metadata":0}],"del":{"EdgeMap":{"edges":[{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52710337},"to":{"change":3,"start":52717591,"end":52717628},"introduced_by":3},{"previous":"BLOCK | FOLDER","flag":"BLOCK | FOLDER | DELETED","from":{"change":3,"pos":52717628},"to":{"change":3,"start":52710370,"end":52710370},"introduced_by":3}],"inode":{"change":3,"pos":52710370}}},"content_edges":{"edges":[{"previous":"BLOCK","flag":"BLOCK | DELETED","from":{"change":3,"pos":52710370},"to":{"change":3,"start":52710371,"end":52717590},"introduced_by":3}],"inode":{"change":3,"pos":52710370}},"content":[{"Del":";;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*-\n\n;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov\n;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors\n;;\n;; Author: Tim King \n;;         Phil Hagelberg \n;;         Bozhidar Batsov \n;;         Artur Malabarba \n;;         Hugo Duncan \n;;         Steve Purcell \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;; This file is not part of GNU Emacs.\n;;\n;;; Commentary:\n;;\n;; Provides functions to interact with and create `nrepl-dict's.  These are\n;; simply plists with an extra element at the head.\n\n;;; Code:\n(require 'cl-lib)\n\n\n(defun nrepl-dict (&rest key-vals)\n  \"Create nREPL dict from KEY-VALS.\"\n  (cons 'dict key-vals))\n\n(defun nrepl-dict-from-hash (hash)\n  \"Create nREPL dict from HASH.\"\n  (let ((dict (nrepl-dict)))\n    (maphash (lambda (k v) (nrepl-dict-put dict k v)) hash)\n    dict))\n\n(defun nrepl-dict-p (object)\n  \"Return t if OBJECT is an nREPL dict.\"\n  (and (listp object)\n       (eq (car object) 'dict)))\n\n(defun nrepl-dict-empty-p (dict)\n  \"Return t if nREPL dict DICT is empty.\"\n  (null (cdr dict)))\n\n(defun nrepl-dict-contains (dict key)\n  \"Return nil if nREPL dict DICT doesn't contain KEY.\nIf DICT does contain KEY, then a non-nil value is returned.  Due to the\ncurrent implementation, this return value is the tail of DICT's key-list\nwhose car is KEY.  Comparison is done with `equal'.\"\n  (member key (nrepl-dict-keys dict)))\n\n(defun nrepl-dict-get (dict key &optional default)\n  \"Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT.\nIf dict is nil, return nil.  If DEFAULT not provided, and KEY not in DICT,\nreturn nil.  If DICT is not an nREPL dict object, an error is thrown.\"\n  (when dict\n    (if (nrepl-dict-p dict)\n        (if (nrepl-dict-contains dict key)\n            (lax-plist-get (cdr dict) key)\n          default)\n      (error \"Not an nREPL dict object: %s\" dict))))\n\n(defun nrepl-dict-put (dict key value)\n  \"Associate in DICT, KEY to VALUE.\nReturn new dict.  Dict is modified by side effects.\"\n  (if (null dict)\n      `(dict ,key ,value)\n    (if (not (nrepl-dict-p dict))\n        (error \"Not an nREPL dict object: %s\" dict)\n      (setcdr dict (lax-plist-put (cdr dict) key value))\n      dict)))\n\n(defun nrepl-dict-keys (dict)\n  \"Return all the keys in the nREPL DICT.\"\n  (if (nrepl-dict-p dict)\n      (cl-loop for l on (cdr dict) by #'cddr\n               collect (car l))\n    (error \"Not an nREPL dict\")))\n\n(defun nrepl-dict-vals (dict)\n  \"Return all the values in the nREPL DICT.\"\n  (if (nrepl-dict-p dict)\n      (cl-loop for l on (cdr dict) by #'cddr\n               collect (cadr l))\n    (error \"Not an nREPL dict\")))\n\n(defun nrepl-dict-map (fn dict)\n  \"Map FN on nREPL DICT.\nFN must accept two arguments key and value.\"\n  (if (nrepl-dict-p dict)\n      (cl-loop for l on (cdr dict) by #'cddr\n               collect (funcall fn (car l) (cadr l)))\n    (error \"Not an nREPL dict\")))\n\n(defun nrepl-dict-merge (dict1 dict2)\n  \"Destructively merge DICT2 into DICT1.\nKeys in DICT2 override those in DICT1.\"\n  (let ((base (or dict1 '(dict))))\n    (nrepl-dict-map (lambda (k v)\n                      (nrepl-dict-put base k v))\n                    (or dict2 '(dict)))\n    base))\n\n(defun nrepl-dict-get-in (dict keys)\n  \"Return the value in a nested DICT.\nKEYS is a list of keys.  Return nil if any of the keys is not present or if\nany of the values is nil.\"\n  (let ((out dict))\n    (while (and keys out)\n      (setq out (nrepl-dict-get out (pop keys))))\n    out))\n\n(defun nrepl-dict-flat-map (function dict)\n  \"Map FUNCTION over DICT and flatten the result.\nFUNCTION follows the same restrictions as in `nrepl-dict-map', and it must\nalso always return a sequence (since the result will be flattened).\"\n  (when dict\n    (apply #'append (nrepl-dict-map function dict))))\n\n(defun nrepl-dict-filter (function dict)\n  \"For all key-values of DICT, return new dict where FUNCTION returns non-nil.\n\nFUNCTION should be a function taking two arguments, key and value.\"\n  (let ((new-map (nrepl-dict))\n        (keys (nrepl-dict-keys dict)))\n    (dolist (key keys)\n      (let ((val (nrepl-dict-get dict key)))\n        (when (funcall function key val)\n          (nrepl-dict-put new-map key val))))\n    new-map))\n\n\f\n;;; More specific functions\n(defun nrepl--cons (car list-or-dict)\n  \"Generic cons of CAR to LIST-OR-DICT.\"\n  (if (eq (car list-or-dict) 'dict)\n      (cons 'dict (cons car (cdr list-or-dict)))\n    (cons car list-or-dict)))\n\n(defun nrepl--nreverse (list-or-dict)\n  \"Generic `nreverse' which works on LIST-OR-DICT.\"\n  (if (eq (car list-or-dict) 'dict)\n      (cons 'dict (nreverse (cdr list-or-dict)))\n    (nreverse list-or-dict)))\n\n(defun nrepl--push (obj stack)\n  \"Cons OBJ to the top element of the STACK.\"\n  ;; stack is assumed to be a list\n  (if (eq (caar stack) 'dict)\n      (cons (cons 'dict (cons obj (cdar stack)))\n            (cdr stack))\n    (cons (if (null stack)\n              obj\n            (cons obj (car stack)))\n          (cdr stack))))\n\n(defun nrepl--merge (dict1 dict2 &optional no-join)\n  \"Join nREPL dicts DICT1 and DICT2 in a meaningful way.\nString values for non \\\"id\\\" and \\\"session\\\" keys are concatenated. Lists\nare appended. nREPL dicts merged recursively. All other objects are\naccumulated into a list. DICT1 is modified destructively and\nthen returned.\nIf NO-JOIN is given, return the first non nil dict.\"\n  (if no-join\n      (or dict1 dict2)\n    (cond ((null dict1) dict2)\n          ((null dict2) dict1)\n          ((stringp dict1) (concat dict1 dict2))\n          ((nrepl-dict-p dict1)\n           (nrepl-dict-map\n            (lambda (k2 v2)\n              (nrepl-dict-put dict1 k2\n                              (nrepl--merge (nrepl-dict-get dict1 k2) v2\n                                            (member k2 '(\"id\" \"session\")))))\n            dict2)\n           dict1)\n          ((and (listp dict2) (listp dict1)) (append dict1 dict2))\n          ((listp dict1) (append dict1 (list dict2)))\n          (t `(,dict1 ,dict2)))))\n\n\f\n;;; Dbind\n(defmacro nrepl-dbind-response (response keys &rest body)\n  \"Destructure an nREPL RESPONSE dict.\nBind the value of the provided KEYS and execute BODY.\"\n  (declare (debug (form (&rest symbolp) body)))\n  `(let ,(cl-loop for key in keys\n                  collect `(,key (nrepl-dict-get ,response ,(format \"%s\" key))))\n     ,@body))\n(put 'nrepl-dbind-response 'lisp-indent-function 2)\n\n(provide 'nrepl-dict)\n\n;;; nrepl-dict.el ends here\n"}]}}],"owner":"jaredj","repo":"dot-emacs","token":"47iNb0et/ZjoIFM6bXyIARRJ8JKXzk3p33YHRUxZ5U4=","login":null}

…

Dependencies

Change contents