Commit a139137b7b02
Changed files (7)
home
common
dev
tools
emacs
home/common/dev/emacs.nix
@@ -84,6 +84,7 @@ let
ibuffer-vc
indent-bars
jinx
+ jira
json-mode
kubed
ligature
tools/emacs/config/config-llm.el
@@ -146,13 +146,11 @@ Here is the result of `git diff --cached`:")
(aidermacs-setup-minor-mode))
(use-package gptel
+ :commands (gptel gptel-mode)
+ :bind (("C-c a g" . gptel))
:hook
(gptel-mode . visual-line-mode)
:bind
- (:map gfm-mode-map
- ("C-c C-k" . gptel-abort)
- ("C-c C-m" . gptel-menu)
- ("C-c C-c" . gptel-send))
(:map gptel-mode-map
("C-c C-k" . gptel-abort)
("C-c C-m" . gptel-menu)
@@ -164,21 +162,23 @@ Here is the result of `git diff --cached`:")
;; "o" '(:ignore t :wk "GPTel")
;; "o o" '(gptel :wk "Start GPTel")
;; "o m" '(gptel-menu :wk "GPTel menu"))
+ (setq mcp-hub-servers
+ `(("jira" :command "/home/vincent/src/github.com/chmouel/jayrah/.venv/bin/jayrah" :args ("mcp"))
+ ("github" :command "github-mcp-server" :args ("stdio")
+ :env (:GITHUB_PERSONAL_ACCESS_TOKEN ,(passage-get "github/vdemeester/github-mcp-server")))))
(require 'gptel-curl)
(require 'gptel-gemini)
(require 'gptel-ollama)
(require 'gptel-transient)
+ (require 'gptel-integrations)
(require 'gptel-rewrite)
(require 'gptel-org)
(require 'gptel-openai)
(require 'gptel-openai-extras)
(require 'gptel-autoloads)
+ (gptel-mcp-connect)
(setq gptel-model 'gemini-2.0-pro-exp
gptel-backend (gptel-make-gemini "Gemini"
- ;; :models '("gemini-2.0-flash"
- ;; "gemini-2.0-flash-lite-preview-02-05"
- ;; "gemini:gemini-2.0-flash-thinking-exp"
- ;; "gemini:gemini-2.0-pro-exp")
:key (passage-get "ai/gemini/api_key"))
)
tools/emacs/config/config-projects.el
@@ -77,5 +77,15 @@
:bind (("C-x p w" . project-x-window-state-save)
("C-x p j" . project-x-window-state-load)))
+(use-package jira
+ :commands (jira-issues)
+ :config
+ (setq jira-base-url "https://issues.redhat.com"
+ jira-username "vdemeest@redhat.com"
+ jira-token (passage-get "redhat/issues/token/myji")
+ jira-token-is-personal-access-token t
+ jira-api-version 2
+ jira-issues-max-results 500))
+
(provide 'config-projects)
;;; config-projects.el ends here
tools/emacs/lisp/mcp-hub.el
@@ -0,0 +1,313 @@
+;;; mcp-hub.el --- manager mcp server -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 lizqwer scott
+
+;; Author: lizqwer scott <lizqwerscott@gmail.com>
+;; Keywords: ai, mcp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'mcp)
+
+(defcustom mcp-hub-servers nil
+ "Configuration for MCP servers.
+Each server configuration is a list of the form
+ (NAME . (:command COMMAND :args ARGS)) or (NAME . (:url URL)), where:
+- NAME is a string identifying the server.
+- COMMAND is the command to start the server.
+- ARGS is a list of arguments passed to the command.
+- URL is a string arguments to connect sse mcp server."
+ :group 'mcp-hub
+ :type '(list (cons string (list symbol string))))
+
+(defun mcp-hub--start-server (server &optional inited-callback)
+ "Start an MCP server with the given configuration.
+SERVER should be a cons cell of the form (NAME . CONFIG) where:
+- NAME is a string identifying the server
+- CONFIG is a plist containing either:
+ - :command and :args for local servers
+ - :url for remote servers
+
+Optional argument INITED-CALLBACK is a function called when the server
+has successfully initialized and tools are available. The callback
+receives no arguments."
+ (apply #'mcp-connect-server
+ (append (list (car server))
+ (cdr server)
+ (list :initial-callback
+ #'(lambda (_)
+ (mcp-hub-update))
+ :tools-callback
+ #'(lambda (_ _)
+ (mcp-hub-update)
+ (when inited-callback
+ (funcall inited-callback)))
+ :prompts-callback
+ #'(lambda (_ _)
+ (mcp-hub-update))
+ :resources-callback
+ #'(lambda (_ _)
+ (mcp-hub-update))
+ :error-callback
+ #'(lambda (_ _)
+ (mcp-hub-update))))))
+
+;;;###autoload
+(cl-defun mcp-hub-get-all-tool (&key asyncp categoryp)
+ "Retrieve all available tools from connected MCP servers.
+This function collects all tools from currently connected MCP servers,
+filtering out any invalid entries. Each tool is created as a text tool
+that can be used for interaction.
+
+When ASYNCP is non-nil, the tools will be created asynchronously.
+
+When CATEGORYP is non-nil, the tools will be add to a category.
+
+Returns a list of text tools created from all valid tools across all
+connected servers. The list excludes any tools that couldn't be created
+due to missing or invalid names.
+
+Example:
+ (mcp-hub-get-all-tool) ; Get all tools synchronously
+ (mcp-hub-get-all-tool t) ; Get all tools asynchronously"
+ (let ((res ))
+ (maphash #'(lambda (name server)
+ (when (and server
+ (equal (mcp--status server)
+ 'connected))
+ (when-let* ((tools (mcp--tools server))
+ (tool-names (mapcar #'(lambda (tool) (plist-get tool :name)) tools)))
+ (dolist (tool-name tool-names)
+ (push (let ((tool (mcp-make-text-tool name tool-name asyncp)))
+ (if categoryp
+ (plist-put
+ tool
+ :category
+ (format "mcp-%s"
+ name))
+ tool))
+ res)))))
+ mcp-server-connections)
+ (nreverse res)))
+
+;;;###autoload
+(defun mcp-hub-start-all-server (&optional callback servers)
+ "Start all configured MCP servers.
+This function will attempt to start each server listed in `mcp-hub-servers'
+if it's not already running.
+
+Optional argument CALLBACK is a function to be called when all servers have
+either started successfully or failed to start.The callback receives no
+arguments.
+
+Optional argument SERVERS is a list of server names (strings) to filter which
+servers should be started. When nil, all configured servers are considered."
+ (interactive)
+ (let* ((servers-to-start (cl-remove-if (lambda (server)
+ (or (not (cl-find (car server) servers :test #'string=))
+ (gethash (car server) mcp-server-connections)))
+ mcp-hub-servers))
+ (total (length servers-to-start))
+ (started 0))
+ (if (zerop total)
+ (progn
+ (message "All MCP servers already running")
+ (when callback (funcall callback)))
+ (message "Starting %d MCP server(s)..." total)
+ (dolist (server servers-to-start)
+ (condition-case err
+ (mcp-hub--start-server
+ server
+ (lambda ()
+ (cl-incf started)
+ (message "Started server %s (%d/%d)" (car server) started total)
+ (when (and callback (>= started total))
+ (funcall callback))))
+ (error
+ (message "Failed to start server %s: %s" (car server) err)
+ (cl-incf started)
+ (when (and callback (>= started total))
+ (funcall callback))))))))
+
+;;;###autoload
+(defun mcp-hub-close-all-server ()
+ "Stop all running MCP servers.
+This function will attempt to stop each server listed in `mcp-hub-servers'
+that is currently running."
+ (interactive)
+ (dolist (server mcp-hub-servers)
+ (when (gethash (car server)
+ mcp-server-connections)
+ (mcp-stop-server (car server))))
+ (mcp-hub-update))
+
+;;;###autoload
+(defun mcp-hub-restart-all-server ()
+ "Restart all configured MCP servers.
+This function first stops all running servers, then starts them again.
+It's useful for applying configuration changes or recovering from errors."
+ (interactive)
+ (mcp-hub-close-all-server)
+ (mcp-hub-start-all-server))
+
+(defun mcp-hub-get-servers ()
+ "Retrieve status information for all configured servers.
+Returns a list of server statuses, where each status is a plist containing:
+- :name - The server's name
+- :status - Either `connected' or `stop'
+- :tools - Available tools (if connected)
+- :resources - Available resources (if connected)
+- :prompts - Available prompts (if connected)"
+ (mapcar #'(lambda (server)
+ (let ((name (car server)))
+ (if-let* ((connection (gethash name mcp-server-connections)))
+ (list :name name
+ :type (mcp--connection-type connection)
+ :status (mcp--status connection)
+ :tools (mcp--tools connection)
+ :resources (mcp--resources connection)
+ :prompts (mcp--prompts connection))
+ (list :name name :status 'stop))))
+ mcp-hub-servers))
+
+(defun mcp-hub-update ()
+ "Update the MCP Hub display with current server status.
+If called interactively, ARG is the prefix argument.
+When SILENT is non-nil, suppress any status messages.
+This function refreshes the *Mcp-Hub* buffer with the latest server information,
+including connection status, available tools, resources, and prompts."
+ (interactive "P")
+ (when-let* ((server-list (mcp-hub-get-servers))
+ (server-show (mapcar #'(lambda (server)
+ (let* ((name (plist-get server :name))
+ (status (plist-get server :status)))
+ (append (list name
+ (symbol-name (plist-get server :type))
+ (pcase status
+ ('connected
+ (propertize (symbol-name status)
+ 'face 'success))
+ ('error
+ (propertize (symbol-name status)
+ 'face 'error))
+ (_
+ (symbol-name status))))
+ (if (equal status 'connected)
+ (mapcar #'(lambda (x)
+ (format "%d"
+ (length x)))
+ (list (plist-get server :tools)
+ (plist-get server :resources)
+ (plist-get server :prompts)))
+ (list "nil" "nil" "nil")))))
+ server-list)))
+ (with-current-buffer (get-buffer-create "*Mcp-Hub*")
+ (setq tabulated-list-entries
+ (cl-mapcar #'(lambda (statu index)
+ (list (format "%d" index)
+ (vconcat statu)))
+ server-show
+ (number-sequence 1 (length server-list))))
+ (tabulated-list-print t))))
+
+;;;###autoload
+(defun mcp-hub ()
+ "View mcp hub server."
+ (interactive)
+ ;; start all server
+ (when (and mcp-hub-servers
+ (= (hash-table-count mcp-server-connections)
+ 0))
+ (mcp-hub-start-all-server))
+ ;; show buffer
+ (pop-to-buffer "*Mcp-Hub*" nil)
+ (mcp-hub-mode))
+
+;;;###autoload
+(defun mcp-hub-start-server ()
+ "Start the currently selected MCP server.
+This function starts the server that is currently highlighted in the *Mcp-Hub*
+buffer. It sets up callbacks for connection status, tools, prompts, and
+resources updates, and refreshes the hub view after starting the server."
+ (interactive)
+ (when-let* ((server (tabulated-list-get-entry))
+ (name (elt server 0))
+ (server-arg (cl-find name mcp-hub-servers :key #'car :test #'equal)))
+ (mcp-hub--start-server server-arg)
+ (mcp-hub-update)))
+
+;;;###autoload
+(defun mcp-hub-close-server ()
+ "Stop the currently selected MCP server.
+This function stops the server that is currently highlighted in the *Mcp-Hub*
+buffer and updates the hub view to reflect the change in status."
+ (interactive)
+ (when-let* ((server (tabulated-list-get-entry))
+ (name (elt server 0)))
+ (mcp-stop-server name)
+ (mcp-hub-update)))
+
+;;;###autoload
+(defun mcp-hub-restart-server ()
+ "Restart the currently selected MCP server.
+This function stops and then starts the server that is currently highlighted
+in the *Mcp-Hub* buffer. It's useful for applying configuration changes or
+recovering from errors."
+ (interactive)
+ (mcp-hub-close-server)
+ (mcp-hub-start-server))
+
+;;;###autoload
+(defun mcp-hub-view-log ()
+ "View the event log for the currently selected MCP server.
+This function opens a buffer showing the event log for the server that is
+currently highlighted in the *Mcp-Hub* buffer."
+ (interactive)
+ (when-let* ((server (tabulated-list-get-entry))
+ (name (elt server 0)))
+ (switch-to-buffer (format "*%s events*"
+ name))))
+
+(define-derived-mode mcp-hub-mode tabulated-list-mode "Mcp Hub"
+ "A major mode for viewing a list of mcp server."
+ (setq-local revert-buffer-function #'mcp-hub-update)
+ (setq tabulated-list-format
+ [("Name" 18 t)
+ ("Type" 10 t)
+ ("Status" 15 t)
+ ("Tools" 10 t)
+ ("Resources" 10 t)
+ ("Prompts" 10 t)])
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key '("Name" . nil))
+ (tabulated-list-init-header)
+
+ (keymap-set mcp-hub-mode-map "l" #'mcp-hub-view-log)
+ (keymap-set mcp-hub-mode-map "s" #'mcp-hub-start-server)
+ (keymap-set mcp-hub-mode-map "k" #'mcp-hub-close-server)
+ (keymap-set mcp-hub-mode-map "r" #'mcp-hub-restart-server)
+ (keymap-set mcp-hub-mode-map "S" #'mcp-hub-start-all-server)
+ (keymap-set mcp-hub-mode-map "R" #'mcp-hub-restart-all-server)
+ (keymap-set mcp-hub-mode-map "K" #'mcp-hub-close-all-server)
+
+ (mcp-hub-update))
+
+(provide 'mcp-hub)
+;;; mcp-hub.el ends here
tools/emacs/lisp/mcp.el
@@ -0,0 +1,973 @@
+;;; mcp.el --- Model Context Protocol -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 lizqwer scott
+
+;; Author: lizqwer scott <lizqwerscott@gmail.com>
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "30.1") (jsonrpc "1.0.25"))
+;; Keywords: ai, mcp
+;; URL: https://github.com/lizqwerscott/mcp.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'jsonrpc)
+(require 'cl-lib)
+(require 'url)
+
+(defconst *MCP-VERSION* "2024-11-05"
+ "MCP support version.")
+
+(defcustom mcp-server-start-time 60
+ "The Seconds of mcp server start time."
+ :group 'mcp
+ :type 'integer)
+
+(defcustom mcp-server-wait-initial-time 2
+ "Seconds to wait after server init before fetching MCP resources.
+
+This delay is applied after server initialization completes, but
+before requesting tools, prompts and resources. Gives the server
+time to fully initialize all components before handling requests."
+ :group 'mcp
+ :type 'integer)
+
+(defcustom mcp-log-level 'info
+ "The min log level for mcp server.
+Available levels:
+- debug: Detailed debugging information (function entry/exit points)
+- info: General informational messages (operation progress updates)
+- notice: Normal but significant events (configuration changes)
+- warning: Warning conditions (deprecated feature usage)
+- error: Error conditions (operation failures)
+- critical: Critical conditions (system component failures)
+- alert: Action must be taken immediately (data corruption detected)
+- emergency: System is unusable (complete system failure)"
+ :group 'mcp
+ :type '(choice (const :tag "debug" debug)
+ (const :tag "info" info)
+ (const :tag "notice" notice)
+ (const :tag "warning" warning)
+ (const :tag "error" error)
+ (const :tag "critical" critical)
+ (const :tag "alert" alert)
+ (const :tag "emergency" emergency)))
+
+(defclass mcp-process-connection (jsonrpc-process-connection)
+ ((connection-type
+ :initarg :connection-type
+ :accessor mcp--connection-type)
+ (-status
+ :initform 'init
+ :accessor mcp--status)
+ (-capabilities
+ :initform nil
+ :accessor mcp--capabilities)
+ (-serverinfo
+ :initform nil
+ :accessor mcp--server-info)
+ (-prompts
+ :initform nil
+ :accessor mcp--prompts)
+ (-tools
+ :initform nil
+ :accessor mcp--tools)
+ (-resources
+ :initform nil
+ :accessor mcp--resources))
+ :documentation "A MCP connection over an Emacs process.")
+
+(defclass mcp-sse-process-connection (mcp-process-connection)
+ ((-host
+ :initarg :host
+ :accessor mcp--host)
+ (-port
+ :initarg :port
+ :accessor mcp--port)
+ (-tls
+ :initarg :tls
+ :accessor mcp--tls)
+ (-endpoint
+ :initform nil
+ :accessor mcp--endpoint))
+ :documentation "A sse MCP connection over an Emacs process.")
+
+(defclass mcp-stdio-process-connection (mcp-process-connection)
+ ()
+ :documentation "A stdio MCP connection over an Emacs process.")
+
+(cl-defmethod initialize-instance :after ((_ mcp-process-connection) slots)
+ "Init mcp process connection."
+ (cl-destructuring-bind (&key ((:process proc)) &allow-other-keys) slots
+ (set-process-filter proc #'mcp--process-filter)))
+
+(cl-defmethod jsonrpc-connection-send ((connection mcp-process-connection)
+ &rest args
+ &key
+ id
+ method
+ _params
+ (_result nil result-supplied-p)
+ error
+ _partial)
+ "Send JSON-RPC message to CONNECTION.
+CONNECTION is an MCP process connection instance. ARGS is a plist
+containing the message components:
+
+METHOD - Method name (string, symbol or keyword)
+PARAMS - Parameters for the method (optional)
+ID - Request ID (optional)
+RESULT - Response result (for replies)
+error - Error object (for error replies)
+partial - Partial response flag (optional)
+
+For requests, both :method and :id should be provided.
+For notifications, only :method is required.
+For replies, either :_result or :error should be provided.
+
+The message is sent differently based on connection type:
+- SSE connections use HTTP POST requests
+- Stdio connections write directly to the process"
+ (when method
+ ;; sanitize method into a string
+ (setq args
+ (plist-put args :method
+ (cond ((keywordp method) (substring (symbol-name method) 1))
+ ((symbolp method) (symbol-name method))
+ ((stringp method) method)
+ (t (error "[jsonrpc] invalid method %s" method))))))
+ (let* ((kind (cond ((or result-supplied-p error) 'reply)
+ (id 'request)
+ (method 'notification)))
+ (converted (jsonrpc-convert-to-endpoint connection args kind))
+ (json (jsonrpc--json-encode converted)))
+ (pcase (mcp--connection-type connection)
+ ('sse
+ (let ((url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-Type" . "application/json")))
+ (url-request-data (encode-coding-string
+ json
+ 'utf-8))
+ (url (format "%s://%s:%s%s"
+ (if (mcp--tls connection) "https" "http")
+ (mcp--host connection)
+ (mcp--port connection)
+ (mcp--endpoint connection))))
+ (url-retrieve url
+ #'(lambda (_)
+ (when (buffer-live-p (current-buffer))
+ (goto-char (point-min))
+ ;; (when (search-forward "\n\n" nil t)
+ ;; (let* ((headers (buffer-substring (point-min) (point)))
+ ;; (body (buffer-substring (point) (point-max)))
+ ;; (response-code (string-match "HTTP/.* \\([0-9]+\\)" headers)))))
+ (kill-buffer))))))
+ ('stdio
+ (process-send-string
+ (jsonrpc--process connection)
+ (format "%s\r\n" json))))
+ (jsonrpc--event
+ connection
+ 'client
+ :json json
+ :kind kind
+ :message args
+ :foreign-message converted)))
+
+(defvar mcp--in-process-filter nil
+ "Non-nil if inside `mcp--process-filter'.")
+
+(cl-defun mcp--process-filter (proc string)
+ "Called when new data STRING has arrived for PROC."
+ (when mcp--in-process-filter
+ ;; Problematic recursive process filters may happen if
+ ;; `jsonrpc-connection-receive', called by us, eventually calls
+ ;; client code which calls `process-send-string' (which see) to,
+ ;; say send a follow-up message. If that happens to writes enough
+ ;; bytes for pending output to be received, we will lose JSONRPC
+ ;; messages. In that case, remove recursiveness by re-scheduling
+ ;; ourselves to run from within a timer as soon as possible
+ ;; (bug#60088)
+ (run-at-time 0 nil #'mcp--process-filter proc string)
+ (cl-return-from mcp--process-filter))
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let* ((conn (process-get proc 'jsonrpc-connection))
+ (queue (or (process-get proc 'jsonrpc-mqueue) nil))
+ (buf (or (process-get proc 'jsonrpc-pending)
+ (plist-get (process-put
+ proc 'jsonrpc-pending
+ (generate-new-buffer " *mcp-jsonrpc-pending*"))
+ 'jsonrpc-pending)))
+ (data (with-current-buffer buf
+ (goto-char (point-max))
+ (insert string)
+ (buffer-string)))
+ (type (mcp--connection-type conn))
+ (parsed-messages nil)
+ (lines (split-string data "\n"))
+ (parsed-index 0)
+ (endpoint-waitp nil)
+ (line-index 0))
+ (dolist (line lines)
+ (pcase type
+ ('sse
+ (cond
+ ((and (<= (+ line-index 1) (length lines))
+ (string-prefix-p "event:" (elt lines (+ line-index 1)))))
+ ((string-prefix-p "event: endpoint" line)
+ (setq endpoint-waitp t))
+ ((string-prefix-p "data: " line)
+ (let ((json-str (if (and endpoint-waitp
+ (string-match "http://[^/]+\\(/[^[:space:]]+\\)" line))
+ (match-string 1 line)
+ (string-trim (substring line 6)))))
+ (unless (string-empty-p json-str)
+ (if endpoint-waitp
+ (setf (mcp--endpoint conn) json-str)
+ (push (cons parsed-index json-str) parsed-messages)
+ (cl-incf parsed-index)))))
+ ((and (mcp--endpoint conn)
+ (not (or (string-prefix-p "2d" line)
+ (string-prefix-p ": ping" line)
+ (string-prefix-p "event: message" line)))
+ (not (with-current-buffer buf (= (point-min) (point-max)))))
+ (let ((json-str (string-trim line)))
+ (unless (string-empty-p json-str)
+ (push (cons parsed-index json-str) parsed-messages)
+ (cl-incf parsed-index))))))
+ ('stdio
+ (let ((json-str (string-trim line)))
+ (unless (string-empty-p json-str)
+ (push (cons parsed-index json-str) parsed-messages)
+ (cl-incf parsed-index)))))
+ (cl-incf line-index))
+ (setq parsed-messages (nreverse parsed-messages))
+
+ (with-current-buffer buf (erase-buffer))
+ ;; Add messages to MQUEUE
+ (dolist (msg parsed-messages)
+ (pcase-let ((`(,_index . ,json-str) msg))
+ (let ((json nil)
+ (json-str (with-current-buffer buf
+ (if (= (point-min) (point-max))
+ json-str
+ (goto-char (point-max))
+ (insert json-str)
+ (buffer-string)))))
+ (condition-case-unless-debug err
+ (setq json (json-parse-string json-str
+ :object-type 'plist
+ :null-object nil
+ :false-object :json-false))
+ (json-parse-error
+ ;; parse error and not because of incomplete json
+ (jsonrpc--warn "Invalid JSON: %s\t %s" (cdr err) json-str))
+ (json-end-of-file
+ ;; Save remaining data to pending for next processing
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (insert json-str)
+ (process-put proc 'jsonrpc-pending buf))))
+ (when json
+ (with-current-buffer buf (erase-buffer))
+ (when (listp json)
+ (setq json (plist-put json :jsonrpc-json json-str))
+ (push json queue))))))
+
+ ;; Save updated queue
+ (process-put proc 'jsonrpc-mqueue queue)
+
+ ;; Dispatch messages in timer
+ (cl-loop with time = (current-time)
+ for msg = (pop queue) while msg
+ do (let ((timer (timer-create)))
+ (timer-set-time timer time)
+ (timer-set-function timer
+ (lambda (conn msg)
+ (with-temp-buffer
+ (jsonrpc-connection-receive conn msg)))
+ (list conn msg))
+ (timer-activate timer)))
+
+ ;; Save final queue (might have been consumed by timer pop)
+ (process-put proc 'jsonrpc-mqueue queue)))))
+
+(defun mcp--sse-connect (process host port path)
+ "Establish SSE connection to server.
+PROCESS is the network process object. HOST and PORT specify the
+server address. PATH is the endpoint path for SSE connection.
+Sends HTTP GET request with SSE headers to initiate the event
+stream connection. Used internally by MCP for SSE-based JSON-RPC
+communication."
+ (process-send-string process
+ (concat
+ (format "GET %s HTTP/1.1\r\n"
+ path)
+ (format "Host: %s:%s\r\n"
+ host
+ port)
+ "Accept: text/event-stream\r\n"
+ "Cache-Control: no-cache\r\n"
+ "Connection: keep-alive\r\n\r\n")))
+
+(cl-defun mcp-notify (connection method &optional (params nil))
+ "Send notification to CONNECTION without expecting response.
+METHOD is the notification name (string or symbol). PARAMS is an
+optional plist of parameters.
+This is a thin wrapper around =jsonrpc-connection-send' that
+omits the :id parameter to indicate it's a notification rather
+than a request."
+ (apply #'jsonrpc-connection-send
+ `(,connection
+ :method ,method
+ ,@(when params
+ (list :params params)))))
+
+(defvar mcp-server-connections (make-hash-table :test #'equal)
+ "Mcp server process.")
+
+(defun mcp-request-dispatcher (name method params)
+ "Default handler for MCP server requests.
+NAME identifies the server connection. METHOD is the requested
+method name. PARAMS contains the method parameters.
+
+This basic implementation just logs the request. Applications
+should override this to implement actual request handling."
+ (message "%s Received request: method=%s, params=%s" name method params))
+
+(defun mcp-notification-dispatcher (connection name method params)
+ "Handle notifications from MCP server.
+CONNECTION is the JSON-RPC connection object. NAME identifies the
+server. METHOD is the notification name. PARAMS contains the
+notification data."
+ (pcase method
+ ('notifications/message
+ (cond ((or (plist-member (mcp--capabilities connection) :logging)
+ (and (plist-member params :level)
+ (plist-member params :data)))
+ (cl-destructuring-bind (&key level data &allow-other-keys) params
+ (let ((logger (plist-get params :logger)))
+ (message "[mcp][%s][%s]%s: %s"
+ name
+ level
+ (if logger
+ (format "[%s]" logger)
+ "")
+ data))))))
+ (_
+ (message "%s Received notification: method=%s, params=%s" name method params))))
+
+(defun mcp-on-shutdown (name)
+ "When NAME mcp server shutdown."
+ (message "%s connection shutdown" name))
+
+(defun mcp--parse-http-url (url)
+ "Parse HTTP/HTTPS URL into connection components.
+URL should be a string in format http(s)://host[:port][/path].
+
+Returns a plist with connection parameters:
+:tls - Boolean indicating HTTPS (t) or HTTP (nil)
+:host - Server hostname (string)
+:port - Port number (integer, defaults to 80/443)
+:path - URL path component (string)
+
+Returns nil if URL is invalid or not HTTP/HTTPS."
+ (when-let* ((url (url-generic-parse-url url))
+ (type (url-type url))
+ (host (url-host url))
+ (filename (url-filename url)))
+ (when (or (string= type "http")
+ (string= type "https"))
+ (let ((port (url-port url))
+ (tls (string= "https" type)))
+ (list :tls tls
+ :host host
+ :port (if port
+ port
+ (if tls
+ 443
+ 80))
+ :path filename)))))
+
+;;;###autoload
+(cl-defun mcp-connect-server (name &key command args url env initial-callback
+ tools-callback prompts-callback
+ resources-callback error-callback)
+ "Connect to an MCP server with NAME, COMMAND, and ARGS or URL.
+
+NAME is a string representing the name of the server.
+COMMAND is a string representing the command to start the server
+in stdio mcp server.
+ARGS is a list of arguments to pass to the COMMAND.
+URL is a string arguments to connect sse mcp server.
+ENV is a plist argument to set mcp server env.
+
+INITIAL-CALLBACK is a function called when the server completes
+the connection.
+TOOLS-CALLBACK is a function called to handle the list of tools
+provided by the server.
+PROMPTS-CALLBACK is a function called to handle the list of prompts
+provided by the server.
+RESOURCES-CALLBACK is a function called to handle the list of
+resources provided by the server.
+ERROR-CALLBACK is a function to call on error.
+
+This function creates a new process for the server, initializes a connection,
+and sends an initialization message to the server. The connection is stored
+in the `mcp-server-connections` hash table for future reference."
+ (unless (gethash name mcp-server-connections)
+ (when-let* ((server-config (cond (command
+ (list :connection-type 'stdio
+ :command command
+ :args args))
+ (url
+ (when-let* ((res (mcp--parse-http-url url)))
+ (plist-put res
+ :connection-type 'sse)))))
+ (connection-type (plist-get server-config :connection-type))
+ (buffer-name (format "*Mcp %s server*" name))
+ (process-name (format "mcp-%s-server" name))
+ (process (pcase connection-type
+ ('sse
+ (get-buffer-create buffer-name)
+ (open-network-stream process-name
+ buffer-name
+ (plist-get server-config :host)
+ (plist-get server-config :port)
+ :type (if (plist-get server-config :tls)
+ 'tls
+ 'network)))
+ ('stdio
+ (let ((env (mapcar #'(lambda (item)
+ (pcase-let* ((`(,key ,value) item))
+ (let ((key (symbol-name key)))
+ (list (substring key 1)
+ (format "%s" value)))))
+ (seq-partition env 2)))
+ (process-environment (copy-sequence process-environment)))
+ (when env
+ (dolist (elem env)
+ (setenv (car elem) (cadr elem))))
+ (make-process
+ :name name
+ :command (append (list command)
+ (plist-get server-config :args))
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ ;; :noquery t
+ :stderr (get-buffer-create
+ (format "*%s stderr*" name))
+ ;; :file-handler t
+ ))))))
+ (when (equal connection-type 'sse)
+ (mcp--sse-connect process
+ (plist-get server-config :host)
+ (plist-get server-config :port)
+ (plist-get server-config :path)))
+ (let ((connection (apply #'make-instance
+ `(,(pcase connection-type
+ ('sse
+ 'mcp-sse-process-connection)
+ ('stdio
+ 'mcp-stdio-process-connection))
+ :connection-type ,connection-type
+ :name ,name
+ :process ,process
+ :request-dispatcher ,(lambda (_ method params)
+ (funcall #'mcp-request-dispatcher name method params))
+ :notification-dispatcher ,(lambda (connection method params)
+ (funcall #'mcp-notification-dispatcher connection name method params))
+ :on-shutdown ,(lambda (_)
+ (funcall #'mcp-on-shutdown name))
+ ,@(when (equal connection-type 'sse)
+ (list :host (plist-get server-config :host)
+ :port (plist-get server-config :port)
+ :tls (plist-get server-config :tls))))))
+ (initial-use-time 0)
+ (initial-timer nil))
+ ;; Initialize connection
+ (puthash name connection mcp-server-connections)
+ (when (equal connection-type 'sse)
+ (setf (mcp--status connection)
+ 'waitendpoint))
+ ;; Send the Initialize message
+ (setf initial-timer
+ (run-with-idle-timer
+ 1
+ t
+ #'(lambda ()
+ (cl-incf initial-use-time)
+ (if (jsonrpc-running-p connection)
+ (when (or (equal connection-type 'stdio)
+ (and (equal connection-type 'sse)
+ (mcp--endpoint connection)))
+ (cancel-timer initial-timer)
+ (mcp-async-initialize-message
+ connection
+ #'(lambda (protocolVersion serverInfo capabilities)
+ (if (string= protocolVersion *MCP-VERSION*)
+ (progn
+ (message "[mcp] Connected! Server `MCP (%s)' now managing." (jsonrpc-name connection))
+ (setf (mcp--capabilities connection) capabilities
+ (mcp--server-info connection) serverInfo)
+ ;; Notify server initialized
+ (mcp-notify connection
+ :notifications/initialized)
+ ;; handle logging
+ (when (plist-member capabilities :logging)
+ (mcp-async-set-log-level connection mcp-log-level))
+ (when initial-callback
+ (funcall initial-callback connection))
+ (run-with-idle-timer mcp-server-wait-initial-time
+ nil
+ #'(lambda ()
+ ;; Get prompts
+ (when (plist-member capabilities :prompts)
+ (mcp-async-list-prompts connection prompts-callback))
+ ;; Get tools
+ (when (plist-member capabilities :tools)
+ (mcp-async-list-tools connection tools-callback))
+ ;; Get resources
+ (when (plist-member capabilities :resources)
+ (mcp-async-list-resources connection resources-callback)))
+ )
+ (setf (mcp--status connection)
+ 'connected))
+ (progn
+ (message "[mcp] Error %s server protocolVersion(%s) not support, client Version: %s."
+ (jsonrpc-name connection)
+ protocolVersion
+ *MCP-VERSION*)
+ (mcp-stop-server (jsonrpc-name connection)))))
+ #'(lambda (code message)
+ (when error-callback
+ (funcall error-callback code message))
+ (setf (mcp--status connection)
+ 'error)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))
+ (when (> initial-use-time mcp-server-start-time)
+ (mcp-stop-server name)
+ (cancel-timer initial-timer)
+ (message "Sadly: mcp server start error timeout")))
+ (cancel-timer initial-timer)
+ (when error-callback
+ (funcall error-callback -1 "mcp server process start error")
+ (setf (mcp--status connection)
+ 'error)
+ (message "Sadly, %s mcp server process start error" name))))))))))
+
+;;;###autoload
+(defun mcp-stop-server (name)
+ "Stop the MCP server with the given NAME.
+If the server is running, it will be shutdown and its connection will be removed
+from `mcp-server-connections'. If no server with the given NAME is found,
+a message will be displayed indicating that the server is not running."
+ (if-let* ((connection (gethash name mcp-server-connections)))
+ (progn
+ (jsonrpc-shutdown connection)
+ (setf (gethash name mcp-server-connections) nil))
+ (message "mcp %s server not started" name)))
+
+(defun mcp--parse-tool-args (properties required)
+ "Parse tool arguments from PROPERTIES and REQUIRED lists.
+
+PROPERTIES is a plist of tool argument properties.
+REQUIRED is a list of required argument names.
+
+The function processes each argument in PROPERTIES, marking optional arguments
+if they are not in REQUIRED. Each argument is parsed into a structured plist
+with :name, :type, and :optional fields.
+
+Returns a list of parsed argument plists."
+ (let ((need-length (- (/ (length properties) 2)
+ (length required))))
+ (cl-mapcar #'(lambda (arg-value required-name)
+ (pcase-let* ((`(,key ,value) arg-value))
+ `( :name ,(substring (symbol-name key) 1)
+ ,@value
+ ,@(unless required-name
+ `(:optional t)))))
+ (seq-partition properties 2)
+ (append required
+ (when (> need-length 0)
+ (make-list need-length nil))))))
+
+
+(defun mcp--parse-tool-call-result (res)
+ "Parse the result of a tool call from RES.
+
+RES is a plist representing the tool call result.
+
+The function extracts text content from the result, concatenating it into
+a single string if multiple text entries are present.
+
+Returns the concatenated text or nil if no text content is found."
+ (string-join
+ (cl-remove-if #'null
+ (mapcar #'(lambda (content)
+ (when (string= "text" (plist-get content :type))
+ (plist-get content :text)))
+ (plist-get res :content)))
+ "\n"))
+
+(defun mcp--generate-tool-call-args (args properties)
+ "Generate tool call arguments from ARGS and PROPERTIES.
+
+ARGS is a list of argument values provided by the caller.
+PROPERTIES is a plist of tool argument properties.
+
+The function matches ARGS to PROPERTIES, filling in default values for missing
+optional arguments. It ensures the generated arguments match the tool's schema.
+
+Returns a plist of argument names and values ready for tool invocation."
+ (let ((need-length (- (/ (length properties) 2)
+ (length args))))
+ (apply #'append
+ (cl-mapcar #'(lambda (arg value)
+ (when-let* ((value (if value
+ value
+ (plist-get (cl-second arg)
+ :default))))
+ (list (cl-first arg)
+ value)))
+ (seq-partition properties 2)
+ (append args
+ (when (> need-length 0)
+ (make-list need-length nil)))))))
+
+;;;###autoload
+(defun mcp-make-text-tool (name tool-name &optional asyncp)
+ "Create a `gptel' tool with the given NAME, TOOL-NAME, and ASYNCP.
+
+NAME is the name of the server connection.
+TOOL-NAME is the name of the tool to be created.
+
+Currently, only synchronous messages are supported.
+
+This function retrieves the tool definition from the server connection,
+constructs a basic tool with the appropriate properties, and returns it.
+The tool is configured to handle input arguments, call the server, and process
+the response to extract and return text content."
+ (when-let* ((connection (gethash name mcp-server-connections))
+ (tools (mcp--tools connection))
+ (tool (cl-find tool-name tools :test #'equal :key #'(lambda (tool) (plist-get tool :name)))))
+ (cl-destructuring-bind (&key description ((:inputSchema input-schema)) &allow-other-keys) tool
+ (cl-destructuring-bind (&key properties required &allow-other-keys) input-schema
+ (list
+ :function (if asyncp
+ #'(lambda (callback &rest args)
+ (when (< (length args) (length required))
+ (error "Error: args not match: %s -> %s" required args))
+ (if-let* ((connection (gethash name mcp-server-connections)))
+ (mcp-async-call-tool connection
+ tool-name
+ (mcp--generate-tool-call-args args properties)
+ #'(lambda (res)
+ (funcall callback
+ (mcp--parse-tool-call-result res)))
+ #'(lambda (code message)
+ (funcall callback
+ (format "call %s tool error with %s: %s"
+ tool-name
+ code
+ message))))
+ (error "Error: %s server not connect" name)))
+ #'(lambda (&rest args)
+ (when (< (length args) (length required))
+ (error "Error: args not match: %s -> %s" required args))
+ (if-let* ((connection (gethash name mcp-server-connections)))
+ (if-let* ((res (mcp-call-tool connection
+ tool-name
+ (mcp--generate-tool-call-args args properties))))
+ (mcp--parse-tool-call-result res)
+ (error "Error: call %s tool error" tool-name))
+ (error "Error: %s server not connect" name))))
+ :name tool-name
+ :async asyncp
+ :description description
+ :args
+ (mcp--parse-tool-args properties (or required '())))))))
+
+(defun mcp-async-set-log-level (connection log-level)
+ "Asynchronously set the log level for the MCP server.
+
+CONNECTION is the MCP connection object.
+LOG-LEVEL is the desired log level, which must be one of:
+- `debug': Detailed debugging information (function entry/exit points)
+- `info': General informational messages (operation progress updates)
+- `notice': Normal but significant events (configuration changes)
+- `warning': Warning conditions (deprecated feature usage)
+- `error': Error conditions (operation failures)
+- `critical': Critical conditions (system component failures)
+- `alert': Action must be taken immediately (data corruption detected)
+- `emergency': System is unusable (complete system failure)
+
+On success, displays a message confirming the log level change.
+On error, displays an error message with the server's response code and message."
+ (jsonrpc-async-request connection
+ :logging/setLevel
+ (list :level (format "%s" log-level))
+ :success-fn
+ #'(lambda (res)
+ (message "[mcp] setLevel success: %s" res))
+ :error-fn (jsonrpc-lambda (&key code message _data)
+ (message "Sadly, mpc server reports %s: %s"
+ code message))))
+
+(defun mcp-async-ping (connection)
+ "Send an asynchronous ping request to the MCP server via CONNECTION.
+
+The function uses `jsonrpc-async-request' to send a ping request.
+On success, it displays a message with the response.
+On error, it displays an error message with the code from the server."
+ (jsonrpc-async-request connection
+ :ping
+ nil
+ :success-fn
+ #'(lambda (res)
+ (message "[mcp] ping success: %s" res))
+ :error-fn (jsonrpc-lambda (&key code message _data)
+ (message "Sadly, mpc server reports %s: %s"
+ code message))))
+
+(defun mcp-async-initialize-message (connection callback &optional error-callback)
+ "Sending an `initialize' request to the CONNECTION.
+
+CONNECTION is the MCP connection object.
+CALLBACK is a function to call upon successful initialization.
+ERROR-CALLBACK is an optional function to call if an error occurs.
+
+This function sends an `initialize' request to the server
+with the client's capabilities and version information."
+ (jsonrpc-async-request connection
+ :initialize
+ (list :protocolVersion "2024-11-05"
+ :capabilities '(:roots (:listChanged t))
+ :clientInfo '(:name "mcp-emacs" :version "0.1.0"))
+ :success-fn
+ #'(lambda (res)
+ (cl-destructuring-bind (&key protocolVersion serverInfo capabilities &allow-other-keys) res
+ (funcall callback protocolVersion serverInfo capabilities)))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (if error-callback
+ (funcall error-callback code message)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))))
+
+(defun mcp-async-list-tools (connection &optional callback error-callback)
+ "Get a list of tools from the MCP server using the provided CONNECTION.
+
+CONNECTION is the MCP connection object.
+CALLBACK is a function to call with the result of the request.
+ERROR-CALLBACK is an optional function to call if the request fails.
+
+This function sends a request to the server to list available tools.
+The result is stored in the `mcp--tools' slot of the CONNECTION object."
+ (jsonrpc-async-request connection
+ :tools/list
+ '(:cursor "")
+ :success-fn
+ #'(lambda (res)
+ (cl-destructuring-bind (&key tools &allow-other-keys) res
+ (setf (mcp--tools connection)
+ tools)
+ (when callback
+ (funcall callback connection tools))))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (if error-callback
+ (funcall error-callback code message)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))))
+
+(defun mcp-call-tool (connection name arguments)
+ "Call a tool on the remote CONNECTION with NAME and ARGUMENTS.
+
+CONNECTION is the MCP connection object.
+NAME is the name of the tool to call.
+ARGGUMENTS is a list of arguments to pass to the tool."
+ (jsonrpc-request connection
+ :tools/call
+ (list :name name
+ :arguments (if arguments
+ arguments
+ #s(hash-table)))))
+
+(defun mcp-async-call-tool (connection name arguments callback error-callback)
+ "Async Call a tool on the remote CONNECTION with NAME and ARGUMENTS.
+
+CONNECTION is the MCP connection object.
+NAME is the name of the tool to call.
+ARGUMENTS is a list of arguments to pass to the tool.
+CALLBACK is a function to call on success.
+ERROR-CALLBACK is a function to call on error."
+ (jsonrpc-async-request connection
+ :tools/call
+ (list :name name
+ :arguments (if arguments
+ arguments
+ #s(hash-table)))
+ :success-fn
+ #'(lambda (res)
+ (funcall callback res))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (funcall error-callback code message))))
+
+(defun mcp-async-list-prompts (connection &optional callback error-callback)
+ "Get list of prompts from the MCP server using the provided CONNECTION.
+
+CONNECTION is the MCP connection object. CALLBACK is an optional function to
+call on success,which will receive the CONNECTION and the list of prompts.
+ERROR-CALLBACK is an optional function to call on error, which will receive the
+error code and message.
+
+The result is stored in the `mcp--prompts' slot of the CONNECTION object."
+ (jsonrpc-async-request connection
+ :prompts/list
+ '(:cursor "")
+ :success-fn
+ #'(lambda (res)
+ (cl-destructuring-bind (&key prompts &allow-other-keys) res
+ (setf (mcp--prompts connection)
+ prompts)
+ (when callback
+ (funcall callback connection prompts))))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (if error-callback
+ (funcall error-callback code message)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))))
+
+(defun mcp-get-prompt (connection name arguments)
+ "Call a prompt on the remote CONNECTION with NAME and ARGUMENTS.
+
+CONNECTION is the MCP connection object.
+NAME is the name of the prompt to call.
+ARGGUMENTS is a list of arguments to pass to the prompt"
+ (jsonrpc-request connection
+ :prompts/get
+ (list :name name
+ :arguments (if arguments
+ arguments
+ #s(hash-table)))))
+
+(defun mcp-async-get-prompt (connection name arguments callback error-callback)
+ "Async Call a prompt on the remote CONNECTION with NAME and ARGUMENTS.
+
+CONNECTION is the MCP connection object.
+NAME is the name of the prompt to call.
+ARGUMENTS is a list of arguments to pass to the prompt.
+CALLBACK is a function to call on successful response.
+ERROR-CALLBACK is a function to call on error."
+ (jsonrpc-async-request connection
+ :prompts/get
+ (list :name name
+ :arguments (if arguments
+ arguments
+ #s(hash-table)))
+ :success-fn
+ #'(lambda (res)
+ (funcall callback res))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (funcall error-callback code message))))
+
+(defun mcp-async-list-resources (connection &optional callback error-callback)
+ "Get list of resources from the MCP server using the provided CONNECTION.
+
+CONNECTION is the MCP connection object. CALLBACK is an optional function to
+call upon successful retrieval of resources. ERROR-CALLBACK is an optional
+function to call if an error occurs during the request.
+
+The result is stored in the `mcp--resources' slot of the CONNECTION object."
+ (jsonrpc-async-request connection
+ :resources/list
+ '(:cursor "")
+ :success-fn
+ #'(lambda (res)
+ (cl-destructuring-bind (&key resources &allow-other-keys) res
+ (setf (mcp--resources connection)
+ resources)
+ (when callback
+ (funcall callback connection resources))))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (if error-callback
+ (funcall error-callback code message)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))))
+(defun mcp-read-resource (connection uri)
+ "Call a resource on the remote CONNECTION with URI.
+
+CONNECTION is the MCP connection object.
+URI is the uri of the resource to call."
+ (jsonrpc-request connection
+ :resources/read
+ (list :uri uri)))
+
+(defun mcp-async-read-resource (connection uri &optional callback error-callback)
+ "Call a resource on the remote CONNECTION with URI.
+
+CONNECTION is the MCP connection object.
+URI is the URI of the resource to call.
+CALLBACK is a function to call with the result on success.
+ERROR-CALLBACK is a function to call with the error code and message on failure.
+
+This function asynchronously reads a resource from the remote connection
+using the specified URI. The result is passed to CALLBACK if the request
+succeeds, or ERROR-CALLBACK if it fails."
+ (jsonrpc-async-request connection
+ :resources/read
+ (list :uri uri)
+ :success-fn
+ #'(lambda (res)
+ (funcall callback res))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (funcall error-callback code message))))
+
+(defun mcp-async-list-resource-templates (connection &optional callback error-callback)
+ "Get list of resource templates from the MCP server using the CONNECTION.
+
+CONNECTION is the MCP connection object. CALLBACK is an optional function to
+call upon successful retrieval of resources. ERROR-CALLBACK is an optional
+function to call if an error occurs during the request."
+ (jsonrpc-async-request connection
+ :resources/templates/list
+ '(:cursor "")
+ :success-fn
+ #'(lambda (res)
+ (cl-destructuring-bind (&key resourceTemplates &allow-other-keys) res
+ (when callback
+ (funcall callback connection resourceTemplates))))
+ :error-fn
+ (jsonrpc-lambda (&key code message _data)
+ (if error-callback
+ (funcall error-callback code message)
+ (message "Sadly, mpc server reports %s: %s"
+ code message)))))
+
+(provide 'mcp)
+;;; mcp.el ends here
tools/emacs/mini/early-init.el
@@ -0,0 +1,57 @@
+;; Do not initialize installed packages
+(setopt package-enable-at-startup nil
+ package-archives nil
+ package-quickstart nil)
+(setopt use-package-ensure-function 'ignore)
+
+;; Do not resize the frame at this early stage
+(setopt frame-inhibit-implied-resize t
+ frame-resize-pixelwise t
+ frame-title-format '("%b")) ;; do not add "GNU Emacs at …"
+
+;; Disable GUI elements
+(push '(menu-bar-lines . 0) default-frame-alist)
+(push '(tool-bar-lines . 0) default-frame-alist)
+(push '(vertical-scroll-bars) default-frame-alist)
+(menu-bar-mode -1)
+(tool-bar-mode -1)
+(scroll-bar-mode -1)
+(horizontal-scroll-bar-mode -1)
+
+(setopt use-dialog-box nil ;; never use dialog-box (no mouse)
+ use-file-dialog nil ;; never use file dialog (gtk)
+ use-short-answers t ;; replace defalias yes-or-no-p
+ read-answer-short t) ;; accepts single-character answer, similar to above
+
+(setopt inhibit-startup-message t
+ inhibit-startup-screen t
+ inhibit-startup-echo-area-message user-login-name ; read the docstring
+ inhibit-startup-buffer-menu t)
+
+(setq gc-cons-threshold most-positive-fixnum
+ gc-cons-percentage 0.5)
+
+(defvar vde--file-name-handler-alist file-name-handler-alist)
+(defvar vde--vc-handled-backends vc-handled-backends)
+(setq file-name-handler-alist nil
+ vc-handled-backends nil)
+
+;; Ignore X resources; its settings would be redundant with the other settings
+;; in this file and can conflict with later config (particularly where the
+;; cursor color is concerned).
+(advice-add #'x-apply-session-resources :override #'ignore)
+(setopt inhibit-x-resources t)
+
+;;
+(when (getenv-internal "DEBUG")
+ (setq init-file-debug t
+ debug-on-error t))
+
+;; - Resetting garbage collection and file-name-handler values.
+(add-hook 'after-init-hook
+ `(lambda ()
+ (setq gc-cons-threshold 67108864 ; 64mb
+ gc-cons-percentage 0.1
+ file-name-handler-alist vde--file-name-handler-alist
+ vc-handled-backends vde--vc-handled-backends)
+ (garbage-collect)) t)
tools/emacs/mini/init.el
@@ -0,0 +1,124 @@
+(defconst emacs-start-time (current-time))
+
+(let ((minver 29))
+ (unless (>= emacs-major-version minver)
+ (error "Your Emacs is too old -- this configuration requires v%s or higher" minver)))
+
+(setq inhibit-default-init t) ; Disable the site default settings
+
+(setq confirm-kill-emacs #'y-or-n-p)
+
+(setq custom-file (locate-user-emacs-file "custom.el"))
+(setq
+ custom-buffer-done-kill nil ; Kill when existing
+ custom-buffer-verbose-help nil ; Remove redundant help text
+ custom-unlispify-tag-names nil ; Show me the real variable name
+ custom-unlispify-menu-entries nil)
+;; Create the custom-file if it doesn't exists
+(unless (file-exists-p custom-file)
+ (write-region "" nil custom-file))
+(load custom-file :no-error-if-file-is-missing)
+
+(setq echo-keystrokes 0.1) ;; display command keystrokes quickly
+
+(global-unset-key (kbd "C-z"))
+(global-unset-key (kbd "C-x C-z"))
+(global-unset-key (kbd "C-h h"))
+
+;; Disable owerwrite-mode, iconify-frame and diary
+(mapc
+ (lambda (command)
+ (put command 'disabled t))
+ '(overwrite-mode iconify-frame diary))
+;; And enable those commands (disabled by default)
+(mapc
+ (lambda (command)
+ (put command 'disabled nil))
+ '(list-timers narrow-to-region narrow-to-page upcase-region downcase-region))
+
+(unless noninteractive
+ (defconst font-height 130
+ "Default font-height to use.")
+ ;; 2024-10-05: Switching from Ubuntu Mono to Cascadia Mono
+ ;; 2024-96-06: Switching from Cascadia Mono to JetBrains Mono
+ (defconst font-family-mono "JetBrains Mono"
+ "Default monospace font-family to use.")
+ (defconst font-family-sans "Ubuntu Sans"
+ "Default sans font-family to use.")
+ ;; Middle/Near East: שלום, السّلام عليكم
+ (when (member "Noto Sans Arabic" (font-family-list))
+ (set-fontset-font t 'arabic "Noto Sans Arabic"))
+ (when (member "Noto Sans Hebrew" (font-family-list))
+ (set-fontset-font t 'arabic "Noto Sans Hebrew"))
+ ;; Africa: ሠላም
+ (when (member "Noto Sans Ethiopic" (font-family-list))
+ (set-fontset-font t 'ethiopic "Noto Sans Ethiopic"))
+
+ ;; If font-family-mono or font-family-sans are not available, use the default Emacs face
+ (set-face-attribute 'default nil
+ :family font-family-mono
+ :height font-height
+ :weight 'regular)
+ (set-face-attribute 'fixed-pitch nil
+ :family font-family-mono
+ :weight 'medium
+ :height font-height)
+ (set-face-attribute 'variable-pitch nil
+ :family font-family-sans
+ :weight 'regular)
+
+ (set-fontset-font t 'symbol "Apple Color Emoji")
+ (set-fontset-font t 'symbol "Noto Color Emoji" nil 'append)
+ (set-fontset-font t 'symbol "Segoe UI Emoji" nil 'append)
+ (set-fontset-font t 'symbol "Symbola" nil 'append)
+
+ (require 'modus-themes)
+ (setopt modus-themes-to-rotate '(modus-operandi modus-vivendi)
+ modus-themes-mixed-fonts t
+ modus-themes-headings '((0 . (variable-pitch semilight 1.5))
+ (1 . (regular 1.4))
+ (2 . (regular 1.3))
+ (3 . (regular 1.2))
+ (agenda-structure . (variable-pitch light 2.2))
+ (agenda-date . (variable-pitch regular 1.3))
+ (t . (regular 1.15))))
+ (load-theme 'modus-operandi :no-confirm))
+
+(setq load-prefer-newer t) ; Always load newer compiled files
+(setq ad-redefinition-action 'accept) ; Silence advice redefinition warnings
+
+;; Configure `use-package' prior to loading it.
+(eval-and-compile
+ (setq use-package-always-ensure nil)
+ (setq use-package-always-defer nil)
+ (setq use-package-always-demand nil)
+ (setq use-package-expand-minimally nil)
+ (setq use-package-enable-imenu-support t)
+ (setq use-package-compute-statistics t))
+
+(eval-when-compile
+ (require 'use-package))
+
+(use-package emacs
+ :hook
+ (after-init . global-hl-line-mode)
+ (after-init . global-completion-preview-mode))
+
+(use-package icomplete
+ :unless noninteractive
+ :hook
+ ;; (icomplete-minibuffer-setup
+ ;; . (lambda()(interactive)
+ ;; (setq-local completion-styles '(flex partial-completion initials basic))))
+ (after-init . fido-vertical-mode)
+ :custom
+ (icomplete-compute-delay 0.01))
+
+(use-package orderless
+ :unless noninteractive
+ :config
+ (setq completion-styles
+ '(orderless basic substring initials flex partial-completion))
+ (setq completion-category-defaults nil)
+ (setq completion-category-overrides nil)
+ )