|
| 1 | +;;; mevedel-compact.el --- Chat compaction -*- lexical-binding: t; -*- |
| 2 | + |
| 3 | +;;; Commentary: |
| 4 | + |
| 5 | +;;; Code: |
| 6 | + |
| 7 | +;; `gptel' |
| 8 | +(defvar gptel-mode) |
| 9 | +(defvar gptel-use-header-line) |
| 10 | +(defvar gptel--header-line-info) |
| 11 | +(defvar gptel--markdown-block-map) |
| 12 | +(declare-function gptel-mode "ext:gptel" (&optional arg)) |
| 13 | +(declare-function gptel-markdown-cycle-block "ext:gptel" ()) |
| 14 | + |
| 15 | +;; `gptel-request' |
| 16 | +(declare-function gptel-fsm-info "ext:gptel-request") |
| 17 | +(declare-function gptel-request "ext:gptel-request") |
| 18 | +(defvar gptel--request-alist) |
| 19 | +(defvar gptel-tools) |
| 20 | +(defvar gptel-use-tools) |
| 21 | + |
| 22 | +;; `mevedel' |
| 23 | +(declare-function mevedel--chat-buffer "mevedel" (&optional create workspace)) |
| 24 | + |
| 25 | +(defcustom mevedel-compact-context-limit 200000 |
| 26 | + "Current models maximum context window in tokens. |
| 27 | +
|
| 28 | +Warning appears in header-line when tokens the of value |
| 29 | +`mevedel-compact-token-threshold'.." |
| 30 | + :type 'integer |
| 31 | + :group 'mevedel) |
| 32 | + |
| 33 | +(defcustom mevedel-compact-token-threshold 0.75 |
| 34 | + "Estimated token threshold for compaction warning. |
| 35 | +Can be either the number of tokens as an integer or a float between 0 |
| 36 | +and 1, used as a ratio." |
| 37 | + :type 'integer |
| 38 | + :group 'mevedel) |
| 39 | + |
| 40 | +(defun mevedel--estimate-tokens () |
| 41 | + "Estimate the number of tokens in the current buffer. |
| 42 | +Only counts text not marked with the `gptel' property `ignore', since |
| 43 | +ignored regions are skipped by the backend parsers." |
| 44 | + (let ((pos (point-min)) |
| 45 | + (total 0)) |
| 46 | + (while (< pos (point-max)) |
| 47 | + (let* ((next (next-single-property-change pos 'gptel nil (point-max))) |
| 48 | + (prop (get-text-property pos 'gptel))) |
| 49 | + (unless (eq prop 'ignore) |
| 50 | + (setq total (+ total (- next pos)))) |
| 51 | + (setq pos next))) |
| 52 | + (/ total 4))) |
| 53 | + |
| 54 | +(defun mevedel--compact-prompt () |
| 55 | + "Return the compaction system prompt." |
| 56 | + "Your task is to create a detailed summary of the conversation so far, |
| 57 | +paying close attention to the user's explicit requests and your previous |
| 58 | +actions. This summary should be thorough in capturing technical details, |
| 59 | +code patterns, and architectural decisions that would be essential for |
| 60 | +continuing development work without losing context. |
| 61 | +
|
| 62 | +Before providing your final summary, wrap your analysis in <analysis> |
| 63 | +tags to organize your thoughts and ensure you've covered all necessary |
| 64 | +points. In your analysis process: |
| 65 | +
|
| 66 | +1. Chronologically analyze each message and section of the conversation. |
| 67 | + For each section thoroughly identify: |
| 68 | + - The user's explicit requests and intents |
| 69 | + - Your approach to addressing the user's requests |
| 70 | + - Key decisions, technical concepts and code patterns |
| 71 | + - Specific details like: |
| 72 | + - file names |
| 73 | + - full code snippets |
| 74 | + - function signatures |
| 75 | + - file edits |
| 76 | + - Errors that you ran into and how you fixed them |
| 77 | + - Pay special attention to specific user feedback that you received, |
| 78 | + especially if the user told you to do something differently. |
| 79 | +
|
| 80 | +2. Double-check for technical accuracy and completeness, addressing each |
| 81 | + required element thoroughly. |
| 82 | +
|
| 83 | +Your summary should include the following sections: |
| 84 | +
|
| 85 | +1. Primary Request and Intent: Capture all of the user's explicit requests and intents in detail |
| 86 | +2. Key Technical Concepts: List all important technical concepts, technologies, and frameworks discussed. |
| 87 | +3. Files and Code Sections: Enumerate specific files and code sections examined, modified, or created. Pay special attention to the most recent messages and include full code snippets where applicable and include a summary of why this file read or edit is important. |
| 88 | +4. Errors and fixes: List all errors that you ran into, and how you fixed them. Pay special attention to specific user feedback that you received, especially if the user told you to do something differently. |
| 89 | +5. Problem Solving: Document problems solved and any ongoing troubleshooting efforts. |
| 90 | +6. All user messages: List ALL user messages that are not tool results. These are critical for understanding the users' feedback and changing intent. |
| 91 | +6. Pending Tasks: Outline any pending tasks that you have explicitly been asked to work on. |
| 92 | +7. Current Work: Describe in detail precisely what was being worked on immediately before this summary request, paying special attention to the most recent messages from both user and assistant. Include file names and code snippets where applicable. |
| 93 | +8. Optional Next Step: List the next step that you will take that is related to the most recent work you were doing. IMPORTANT: ensure that this step is DIRECTLY in line with the user's most recent explicit requests, and the task you were working on immediately before this summary request. If your last task was concluded, then only list next steps if they are explicitly in line with the users request. Do not start on tangential requests or really old requests that were already completed without confirming with the user first. |
| 94 | + If there is a next step, include direct quotes from the most recent conversation showing exactly what task you were working on and where you left off. This should be verbatim to ensure there's no drift in task interpretation. |
| 95 | +
|
| 96 | +Here's an example of how your output should be structured: |
| 97 | +
|
| 98 | +<example> |
| 99 | +<analysis> |
| 100 | +[Your thought process, ensuring all points are covered thoroughly and accurately] |
| 101 | +</analysis> |
| 102 | +
|
| 103 | +<summary> |
| 104 | +1. Primary Request and Intent: |
| 105 | + [Detailed description] |
| 106 | +
|
| 107 | +2. Key Technical Concepts: |
| 108 | + - [Concept 1] |
| 109 | + - [Concept 2] |
| 110 | + - [...] |
| 111 | +
|
| 112 | +3. Files and Code Sections: |
| 113 | + - [File Name 1] |
| 114 | + - [Summary of why this file is important] |
| 115 | + - [Summary of the changes made to this file, if any] |
| 116 | + - [Important Code Snippet] |
| 117 | + - [File Name 2] |
| 118 | + - [Important Code Snippet] |
| 119 | + - [...] |
| 120 | +
|
| 121 | +4. Errors and fixes: |
| 122 | + - [Detailed description of error 1]: |
| 123 | + - [How you fixed the error] |
| 124 | + - [User feedback on the error if any] |
| 125 | + - [...] |
| 126 | +
|
| 127 | +5. Problem Solving: |
| 128 | + [Description of solved problems and ongoing troubleshooting] |
| 129 | +
|
| 130 | +6. All user messages: |
| 131 | + - [Detailed non tool use user message] |
| 132 | + - [...] |
| 133 | +
|
| 134 | +7. Pending Tasks: |
| 135 | + - [Task 1] |
| 136 | + - [Task 2] |
| 137 | + - [...] |
| 138 | +
|
| 139 | +8. Current Work: |
| 140 | + [Precise description of current work] |
| 141 | +
|
| 142 | +9. Optional Next Step: |
| 143 | + [Optional Next step to take] |
| 144 | +
|
| 145 | +</summary> |
| 146 | +</example> |
| 147 | +
|
| 148 | +Please provide your summary based on the conversation so far, following this structure and ensuring precision and thoroughness in your response. |
| 149 | +
|
| 150 | +There may be additional summarization instructions provided in the included context. If so, remember to follow these instructions when creating the above summary. Examples of instructions include: |
| 151 | +<example> |
| 152 | +## Compact Instructions |
| 153 | +When summarizing the conversation focus on typescript code changes and also remember the mistakes you made and how you fixed them. |
| 154 | +</example> |
| 155 | +
|
| 156 | +<example> |
| 157 | +# Summary instructions |
| 158 | +When you are using compact - please focus on test output and code changes. Include file reads verbatim. |
| 159 | +</example>") |
| 160 | + |
| 161 | +(defun mevedel--token-header-segment () |
| 162 | + "Return a header-line segment showing estimated token count. |
| 163 | +Returns a propertized string when tokens exceed 80% of |
| 164 | +`mevedel-compact-token-threshold', or an empty string otherwise." |
| 165 | + (let* ((tokens (mevedel--estimate-tokens)) |
| 166 | + (context-width mevedel-compact-context-limit) |
| 167 | + (threshold mevedel-compact-token-threshold)) |
| 168 | + (if (cond ((integerp threshold) |
| 169 | + (> tokens threshold)) |
| 170 | + ((floatp threshold) |
| 171 | + (> (/ (float tokens) context-width) threshold))) |
| 172 | + (let* ((ratio (/ (float tokens) context-width)) |
| 173 | + (face (if (>= ratio 1.0) 'error 'warning))) |
| 174 | + (propertize (format " [Context: %dk/%dk] " |
| 175 | + (/ tokens 1000) |
| 176 | + (/ threshold 1000)) |
| 177 | + 'face face)) |
| 178 | + ""))) |
| 179 | + |
| 180 | +(defun mevedel--compact-buffer-active-p (buf) |
| 181 | + "Return non-nil if BUF has an active gptel request." |
| 182 | + (cl-find-if |
| 183 | + (lambda (entry) |
| 184 | + (eq (thread-first (cadr entry) |
| 185 | + (gptel-fsm-info) |
| 186 | + (plist-get :buffer)) |
| 187 | + buf)) |
| 188 | + gptel--request-alist)) |
| 189 | + |
| 190 | +(defun mevedel--compact-find-boundary () |
| 191 | + "Find the compaction boundary in the current buffer. |
| 192 | +Walks backward from the end to find the end of the last response. |
| 193 | +Everything up to that point will be compacted. Returns the position just |
| 194 | +after the last response, or nil if no response exists." |
| 195 | + (let ((pos (point-max))) |
| 196 | + (while (and pos (not (eq (get-text-property pos 'gptel) 'response))) |
| 197 | + (setq pos (previous-single-property-change pos 'gptel))) |
| 198 | + ;; pos is now inside the last response region (or nil). |
| 199 | + ;; Find where this response region ends. |
| 200 | + (when pos |
| 201 | + (next-single-property-change pos 'gptel nil (point-max))))) |
| 202 | + |
| 203 | +(defun mevedel--compact-apply (boundary summary) |
| 204 | + "Apply compaction to the current buffer at BOUNDARY with SUMMARY. |
| 205 | +Marks content before BOUNDARY as ignored and dimmed, inserts a separator |
| 206 | +and the SUMMARY text at BOUNDARY." |
| 207 | + (let ((inhibit-read-only t)) |
| 208 | + ;; Mark old content as ignored by parsers |
| 209 | + (put-text-property (point-min) boundary 'gptel 'ignore) |
| 210 | + ;; Dim old content visually |
| 211 | + (put-text-property (point-min) boundary 'face 'shadow) |
| 212 | + ;; Insert separator and summary at boundary |
| 213 | + (save-excursion |
| 214 | + (goto-char boundary) |
| 215 | + (let ((sep (format "\n\n--- Conversation compacted at %s ---\n\n" |
| 216 | + (format-time-string "%Y-%m-%d %H:%M")))) |
| 217 | + ;; Remove any inherited gptel properties from the inserted text |
| 218 | + (remove-text-properties 0 (length summary) '(gptel nil face nil) summary) |
| 219 | + |
| 220 | + ;; (add-text-properties |
| 221 | + ;; 0 (length sep) '(gptel ignore) sep) |
| 222 | + (insert |
| 223 | + (propertize sep 'gptel 'ignore) |
| 224 | + (if (derived-mode-p 'org-mode) |
| 225 | + (propertize "#+begin_summary\n" 'gptel 'ignore) |
| 226 | + (propertize "``` summary\n" 'gptel 'ignore |
| 227 | + 'keymap gptel--markdown-block-map)) |
| 228 | + summary |
| 229 | + (if (derived-mode-p 'org-mode) |
| 230 | + (concat "\n" (propertize "#+end_summary\n" 'gptel 'ignore)) |
| 231 | + (concat "\n" (propertize "```\n" 'gptel 'ignore |
| 232 | + 'keymap gptel--markdown-block-map)))) |
| 233 | + ;; Fold the summary immediately. |
| 234 | + (ignore-errors |
| 235 | + (if (derived-mode-p 'org-mode) |
| 236 | + (save-excursion |
| 237 | + (search-backward "#+begin_summary" boundary t) |
| 238 | + (when (looking-at "^#+begin_summary") |
| 239 | + (org-cycle))) |
| 240 | + (save-excursion |
| 241 | + (when (re-search-backward "^```" boundary t) |
| 242 | + (gptel-markdown-cycle-block))))))))) |
| 243 | + |
| 244 | +;;;###autoload |
| 245 | +(defun mevedel-compact () |
| 246 | + "Compact the conversation in the current mevedel chat buffer. |
| 247 | +Summarizes old exchanges via an LLM call and marks them as ignored, so |
| 248 | +only the summary and the last exchange are sent in future requests." |
| 249 | + (interactive) |
| 250 | + (let* ((chat-buffer |
| 251 | + (cond |
| 252 | + ((and (bound-and-true-p gptel-mode) (bound-and-true-p mevedel--workspace)) |
| 253 | + (current-buffer)) |
| 254 | + (t (mevedel--chat-buffer))))) |
| 255 | + (unless (and chat-buffer (buffer-live-p chat-buffer)) |
| 256 | + (user-error "No mevedel chat buffer found")) |
| 257 | + (with-current-buffer chat-buffer |
| 258 | + ;; Guard: refuse if active request |
| 259 | + (when (mevedel--compact-buffer-active-p chat-buffer) |
| 260 | + (user-error "Cannot compact while a request is active")) |
| 261 | + ;; Guard: refuse if not enough content |
| 262 | + (let ((boundary (mevedel--compact-find-boundary))) |
| 263 | + (unless boundary |
| 264 | + (user-error "Not enough conversation content to compact")) |
| 265 | + (let* ((boundary-marker (copy-marker boundary)) |
| 266 | + (old-content (buffer-substring-no-properties (point-min) boundary)) |
| 267 | + (tokens-before (mevedel--estimate-tokens))) |
| 268 | + (when (and gptel-mode gptel-use-header-line header-line-format) |
| 269 | + (setf (nth 2 header-line-format) |
| 270 | + (propertize " Compacting conversation... " 'face 'warning))) |
| 271 | + ;; Send compaction request without tools or transforms |
| 272 | + (let ((gptel-tools nil) |
| 273 | + (gptel-use-tools nil)) |
| 274 | + (gptel-request old-content |
| 275 | + :system (mevedel--compact-prompt) |
| 276 | + :buffer chat-buffer |
| 277 | + :stream nil |
| 278 | + :transforms nil |
| 279 | + :callback |
| 280 | + (lambda (response info) |
| 281 | + (pcase response |
| 282 | + ('nil (user-error "Compaction failed: %s" (plist-get info :error))) |
| 283 | + ((pred stringp) |
| 284 | + (with-current-buffer chat-buffer |
| 285 | + (mevedel--compact-apply boundary-marker response) |
| 286 | + (set-marker boundary-marker nil) |
| 287 | + (when (and gptel-mode gptel-use-header-line header-line-format) |
| 288 | + (setf (nth 2 header-line-format) gptel--header-line-info)) |
| 289 | + (message "Compaction complete: %dk → %dk tokens" |
| 290 | + (/ tokens-before 1000) |
| 291 | + (/ (mevedel--estimate-tokens) 1000)))) |
| 292 | + ('abort |
| 293 | + (user-error "Compaction aborted by user"))))))))))) |
| 294 | + |
| 295 | +(provide 'mevedel-compact) |
| 296 | +;;; mevedel-compact.el ends here |
0 commit comments