consult-gh.el (131517B)
1 ;;; consult-gh.el --- Consulting GitHub Client -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2023 Armin Darvish 4 5 ;; Author: Armin Darvish 6 ;; Maintainer: Armin Darvish 7 ;; Created: 2023 8 ;; Version: 1.0.0 9 ;; Package-Requires: ((emacs "27.1") (consult "0.34")) 10 ;; Homepage: https://github.com/armindarvish/consult-gh 11 ;; Keywords: convenience, matching, tools, vc 12 13 ;;; Commentary: 14 15 ;;; Code: 16 17 ;;; Requirements 18 19 (eval-when-compile 20 (require 'json) 21 ) 22 23 (require 'consult) 24 (require 'crm) 25 26 ;;; Group 27 28 (defgroup consult-gh nil 29 "Consult-based interface for GitHub CLI" 30 :group 'convenience 31 :group 'minibuffer 32 :group 'consult 33 :group 'magit 34 :prefix "consult-gh-" 35 :link '(url-link :tag "GitHub" "https://github.com/armindarvish/consult-gh")) 36 37 ;;; Customization Variables 38 39 (defcustom consult-gh-args '("gh") 40 "Command line arguments to call GitHub CLI, see `consult-gh-search-repos'. 41 42 The dynamically computed arguments are appended. 43 Can be either a string, or a list of strings or expressions." 44 :group 'consult-gh 45 :type '(choice string (repeat (choice string sexp)))) 46 47 (defcustom consult-gh-tempdir (expand-file-name "consult-gh" temporary-file-directory) 48 "Temporary file directory for the `consult-gh' package. 49 50 This directory is used for storing temporary files when pulling files for viewing." 51 :group 'consult-gh 52 :type 'directory 53 ) 54 55 (defcustom consult-gh-crm-separator crm-separator 56 "Separator for multiple selections with completing-read-multiple. 57 58 For more info, see `crm-separator'. Uses crm-separator for default. 59 This is obsolete in version>=1.0.0. 60 " 61 :group 'consult-gh 62 :type 'regexp) 63 64 (defcustom consult-gh-repo-maxnum 30 65 "Maximum number of repos to show for list and search operations. 66 67 This is the value passed to \"--limit\" in the command line. The default is set to gh's default config, 30" 68 :group 'consult-gh 69 :type 'integer) 70 71 (defcustom consult-gh-issue-maxnum 30 72 "Maximum number of issues to show for list and search operations. 73 74 This is the value passed to \"--limit\" in the command line. The default is set to gh's default config, 30" 75 :group 'consult-gh 76 :type 'integer) 77 78 (defcustom consult-gh-pr-maxnum 30 79 "Maximum number of PRs to show for list and search operations. 80 81 This is the value passed to \"--limit\" in the command line. The default is set to gh's default config, 30" 82 :group 'consult-gh 83 :type 'integer) 84 85 (defcustom consult-gh-code-maxnum 30 86 "Maximum number of codes to show for list and search operations. 87 88 This is the value passed to \"--limit\" in the command line. The default is set to gh's default config, 30" 89 :group 'consult-gh 90 :type 'integer) 91 92 (defcustom consult-gh-issues-state-to-show "open" 93 "Which type of issues should be listed by `consult-gh-issue-list'? 94 95 This is what is passed to \"--state\" argument in the command line when running `gh issue list`. The possible options are \"open\", \"closed\" or\"all\"." 96 :group 'consult-gh 97 :type '(choice "open" "closed" "all")) 98 99 (defcustom consult-gh-prs-state-to-show "open" 100 "Which type of PRs should be listed by `consult-gh-pr-list'? 101 102 This is what is passed to \"--state\" argument in the command line when running `gh pr list`. The possible options are \"open\", \"closed\", \"merged\", or\"all\"." 103 :group 'consult-gh 104 :type '(choice "open" "closed" "merged" "all")) 105 106 (defcustom consult-gh-large-file-warning-threshold large-file-warning-threshold 107 "Thresld for size of file to require confirmation for preview/open/save. 108 Files larger than this value in size will require user confirmation before previewing, opening or saving the file. Default value is set by `large-file-warning-threshold'. If nil, no cofnirmation is required." 109 :group 'consult-gh 110 :type '(choice integer (const :tag "Never request confirmation" nil))) 111 112 (defcustom consult-gh-prioritize-local-folder 'suggest 113 "How to use the local repository for completion? 114 115 There are three options, 'suggest (default), nil or t. 116 117 When set to 'suggest, the git repository from the local folder (i.e. `default-directory'), is added to the future history list so it can quickly be accessed by `next-history-element' (default keybinding `M-n`) when running commands such as `consult-gh-issue-list' or `consult-gh-find-file'. 118 119 When set to t, the git repository from the local folder is used as initial-input value for commands such as `consult-gh-issue-list' or `consult-gh-find-file'. The entry can still be changed by user input. If there is no GitHub repository in the `default-directory', it falls back to no initial input. 120 121 When set to nil, the git repository from the local folder is ignored and no initial input is provided." 122 123 :group 'consult-gh 124 :type '(choice (const :tag "Current repository is in future history" 'suggest) 125 (const :tag "Current repository is default input" t) 126 (const :tag "Current repository is ignored" nil))) 127 128 (defcustom consult-gh-preview-buffer-mode 'markdown-mode 129 "Major mode to preview repository's READMEs. 130 131 Choices are 'markdown-mode or 'org-mode." 132 :group 'consult-gh 133 :type '(choice (const :tag "Use default Markdown Style" 'markdown-mode) 134 (const :tag "Covert Markdown to Org-mode" 'org-mode))) 135 136 (defcustom consult-gh-default-orgs-list (list) 137 "List of default GitHub orgs. 138 139 It's generally useful to add personal accounts or frequently 140 visited organizations." 141 :group 'consult-gh 142 :type '(repeat (string :tag "GitHub Organization (i.e. Username)"))) 143 144 (defcustom consult-gh-preview-buffer-name "*consult-gh-preview*" 145 "Default name for preview buffers." 146 :group 'consult-gh 147 :type 'string) 148 149 (defcustom consult-gh-show-preview nil 150 "Should consult-gh show previews? 151 152 It turns previews on/off globally for all categories (repos, issues, prs, codes, files,...)" 153 :group 'consult-gh 154 :type 'boolean) 155 156 (defcustom consult-gh-preview-key consult-preview-key 157 "What key to use to show preview for consult-gh? 158 159 This key is bound in minibuffer, and is similar to `consult-preview-key' (the default) but explicitly for consult-gh. This is used for all categories (repos, issues, prs, codes, files, etc.)" 160 :type '(choice (const :tag "Any key" any) 161 (list :tag "Debounced" 162 (const :debounce) 163 (float :tag "Seconds" 0.1) 164 (const any)) 165 (const :tag "No preview" nil) 166 (key :tag "Key") 167 (repeat :tag "List of keys" key))) 168 169 (defcustom consult-gh-default-clone-directory "~/" 170 "Where should GitHub repos be cloned to by default?" 171 :group 'consult-gh 172 :type 'directory) 173 174 (defcustom consult-gh-default-save-directory "~/Downloads/" 175 "Where should single files be saved by default? 176 177 *Note that this is use for saving individual files (see `consult-gh--files-save-file-action'), and not cloning entire repositories." 178 :group 'consult-gh 179 :type 'directory) 180 181 (defcustom consult-gh-confirm-before-clone t 182 "Should confirmation of path and name be requested before cloning? 183 184 When set to nil, the default directory 185 `consult-gh-default-clone-directory' and package name are used 186 without confirmation." 187 :group 'consult-gh 188 :type 'boolean) 189 190 (defcustom consult-gh-confirm-name-before-fork nil 191 "Should the new repository name be confirmed when forking a repository? 192 193 When set to nil (default), the original repo's name will be used, otherwise request a name." 194 :group 'consult-gh 195 :type 'boolean) 196 197 (defcustom consult-gh-ask-for-path-before-save t 198 "Should file path be confirmed when saving files? 199 200 When set to nil, the default directory (`consult-gh-default-save-directory') and the buffer 201 file name (variable `buffer-file-name') are used, otherwise a file path is requested." 202 :group 'consult-gh 203 :type 'boolean) 204 205 (defcustom consult-gh-default-branch-to-load 'ask 206 "Which branch of repository to load by default in `consult-gh-find-file'? 207 208 Possible values are: 209 210 'confirm: Ask for confirmation if \"HEAD\" branch should be loaded. If not, then the user can choose a different branch. 211 212 'ask: Asks the user to select a branch. 213 214 'nil: load the \"HEAD\" branch, no questions asked. 215 216 A symbol: loads the branch naemd in this variable. 217 218 *Note that when this is set to a specific branch, it is used for any repository that is fetched and if the branch does not exist, it will cause an error. Therefore, using a specific branch is not recommended as a general case but in temporary settings where one is sure the branch exists on the repositories being fetched.*" 219 220 :group 'consult-gh 221 :type '(choice (const :tag "Ask for a branch name" ask) 222 (const :tag "Ask user to confirm loading HEAD, and if \"No\", ask for a branch name" confirm) 223 (const :tag "Loads the HEAD Branch, without confirmation" 224 nil) 225 (symbol :tag "Loads Specific Branch") 226 )) 227 228 (defcustom consult-gh-repo-action #'consult-gh--repo-browse-url-action 229 "What function to call when a repo is selected? 230 231 Common options include: 232 - `consult-gh--repo-browse-url-action' (default): browses the repo's url in default browser 233 - `consult-gh--repo-browse-files-action': Open files in Emacs (Downloads files from GitHub) 234 - `consult-gh--repo-view-action': Open repository's READMEe in Emacs 235 - `consult-gh--repo-clone-action': Cone the repository 236 - `consult-gh--repo-fork-action': Fork the repository 237 - A custom function: The function must take only 1 input argument, the repo candidate." 238 :group 'consult-gh 239 :type '(choice (function :tag "Browse the Repository URL in default browser" #'consult-gh--repo-browse-url-action) 240 (function :tag "Open the Repository's README in an Emacs buffer" #'consult-gh--repo-view-action) 241 (function :tag "Browse Brnaches and Files inside Emacs" #'consult-gh--repo-browse-files-action) 242 (function :tag "Clone Repository to local folder" #'consult-gh--repo-clone-action) 243 (function :tag "Fork Repository" #'consult-gh--repo-fork-action) 244 (function :tag "Custom Function"))) 245 246 (defcustom consult-gh-issue-action #'consult-gh--issue-browse-url-action 247 "What function to call when an issue is selected? 248 249 Common options include: 250 - `consult-gh--issue-browse-url-action' (default): browses the issue url in default browser 251 - `consult-gh--issue-view-action': Open issue in Emacs (Downloads issue's info from GitHub) 252 - `consult-gh-forge--issue-view-action' (when `consult-gh-forge' module is loaded): Open issue in a 'forge-topic-mode' buffer. 253 - A custom function: The function must take only 1 input argument, the issue candidate." 254 :group 'consult-gh 255 :type (if (featurep 'consult-gh-forge) '(choice (const :tag "Browse the Issue URL in default browser" #'consult-gh--issue-browse-url-action) 256 (const :tag "Open the Issue in an Emacs buffer" #'consult-gh--issue-view-action) 257 (const :tag "Open the Issue in a Magit/Forge buffer" #'consult-gh-forge--issue-view-action) 258 (function :tag "Custom Function")) 259 '(choice (const :tag "Open the Issue URL in default browser" #'consult-gh--issue-browse-url-action) 260 (const :tag "Open the Issue in an Emacs buffer" #'consult-gh--issue-view-action) 261 (const :tag "Open the Issue in a Magit/Forge buffer" #'consult-gh-forge--issue-view-action) 262 (function :tag "Custom Function")) 263 )) 264 265 (defcustom consult-gh-pr-action #'consult-gh--pr-browse-url-action 266 "What function to call when a PR is selected? 267 268 Common options include: 269 - `consult-gh--pr-browse-url-action' (default): browses the PR url in default browser 270 - `consult-gh--pr-view-action': Open PR in Emacs (Downloads PR's info from GitHub) 271 - `consult-gh-forge--pr-view-action' (when `consult-gh-forge' module is loaded): Open PR in a 'forge-topic-mode' buffer. 272 - A custom function: The function must take only 1 input argument, the PR candidate." 273 :group 'consult-gh 274 :type (if (featurep 'consult-gh-forge) '(choice (const :tag "Browse the PR URL in default browser" #'consult-gh--pr-browse-url-action) 275 (const :tag "Open the PR in an Emacs buffer" #'consult-gh--pr-view-action) 276 (const :tag "Open the PR in a Magit/Forge buffer" #'consult-gh-forge--pr-view-action) 277 (function :tag "Custom Function")) 278 '(choice (const :tag "Open the PR URL in default browser" #'consult-gh--pr-browse-url-action) 279 (const :tag "Open the PR in an Emacs buffer" #'consult-gh--pr-view-action) 280 (function :tag "Custom Function")) 281 )) 282 283 (defcustom consult-gh-code-action #'consult-gh--code-browse-url-action 284 "What function to call when a code is selected? 285 286 Common options include: 287 - `consult-gh--code-browse-url-action' (default): browses the code (i.e. target file) url in default browser 288 - `consult-gh--pr-view-action': Open the code (i.e. target file) in Emacs (Downloads the file from GitHub) 289 - A custom function: The function must take only 1 input argument, the code candidate." 290 :group 'consult-gh 291 :type '(choice (const :tag "Browse the Code (target file) URL in default browser" consult-gh--code-browse-url-action) 292 (const :tag "Open code (target file) in an Emacs buffer" consult-gh--code-view-action) 293 (function :tag "Custom Function"))) 294 295 (defcustom consult-gh-file-action #'consult-gh--files-browse-url-action 296 "What function to call when a code is selected? 297 298 Common options include: 299 - `consult-gh--files-browse-url-action' (default): browses the file url in default browser 300 - `consult-gh--files-view-action': Open the file in Emacs (Downloads the file from GitHub) 301 - A custom function: The function must take only 1 input argument, the file candidate." 302 :group 'consult-gh 303 :type '(choice (const :tag "Browse the File URL" consult-gh--files-browse-url-action) 304 (const :tag "Save the File to local folder" consult-gh--files-view-action) 305 (function :tag "Custom Function"))) 306 307 (defcustom consult-gh-highlight-matches t 308 "Should queries or code snippets be highlighted in preview buffers?" 309 :group 'consult-gh 310 :type 'boolean) 311 312 ;;; Other Variables 313 (defvar consult-gh-category 'consult-gh 314 "Category symbol for the `consult-gh' package.") 315 316 (defvar consult-gh-repos-category 'consult-gh-repos 317 "Category symbol for repos in `consult-gh' package.") 318 319 (defvar consult-gh-issues-category 'consult-gh-issues 320 "Category symbol for issues in `consult-gh' package.") 321 322 (defvar consult-gh-prs-category 'consult-gh-prs 323 "Category symbol for PRs in `consult-gh' package.") 324 325 (defvar consult-gh-codes-category 'consult-gh-codes 326 "Category symbol for codes in `consult-gh' package.") 327 328 (defvar consult-gh-orgs-category 'consult-gh-orgs 329 "Category symbol for Orgs in `consult-gh' package.") 330 331 (defvar consult-gh-files-category 'consult-gh-files 332 "Category symbol for files in `consult-gh' package.") 333 334 (defvar consult-gh--preview-buffers-list (list) 335 "List of currently open preview buffers") 336 337 (defvar consult-gh--orgs-history nil 338 "History variable for Orgs used in `consult-gh-repo-list'.") 339 340 (defvar consult-gh--repos-history nil 341 "History variable for repos used in `consult-gh-issue-list', and `consult-gh-pr-list'.") 342 343 (defvar consult-gh--search-repos-history nil 344 "History variable for searching repos in `consult-gh-search-repos'.") 345 346 (defvar consult-gh--search-issues-history nil 347 "History variable for issues used in `consult-gh-search-issues'.") 348 349 (defvar consult-gh--search-prs-history nil 350 "History variable for pull requests used in `consult-gh-search-prs'.") 351 352 (defvar consult-gh--search-code-history nil 353 "History variable for pull requests used in `consult-gh-search-code'.") 354 355 (defvar consult-gh--files-history nil 356 "History variable for files used in `consult-gh-find-file'.") 357 358 (defvar consult-gh--known-orgs-list nil 359 "List of previously visited Orgs.") 360 361 (defvar consult-gh--known-repos-list nil 362 "List of previously visited repos.") 363 364 ;;; Faces 365 (defface consult-gh-success-face 366 `((t :inherit 'success)) 367 "the face used to show issues or PRS that are successfully dealt with (e.g. \"closed\" issues or \"merged\" PRS) when listing or searching issues and PRS with `consult-gh'; by default inherits from `success'.") 368 369 (defface consult-gh-warning-face 370 `((t :inherit 'warning)) 371 "the face to show currently open issues or PRS when listing or searching issues and PRS with `consult-gh'; by default inherits from `warning'.") 372 373 (defface consult-gh-error-face 374 `((t :inherit 'error)) 375 "the face to show closed PRS when listing or searching PRS with `consult-gh'; by default inherits from `error'.") 376 377 (defface consult-gh-highlight-match-face 378 `((t :inherit 'consult-highlight-match)) 379 "highlight match face in `consult-gh''s preview buffers. 380 By default, inherits from `consult-highlight-match'. ") 381 382 (defface consult-gh-preview-match-face 383 `((t :inherit 'consult-preview-match)) 384 "highlight match face in `consult-gh''s preview buffers. 385 By default, inherits from `consult-preview-match'. This face is for example used to highlight the matches to the user's search queries (e.g. when using `consult-gh-search-repos') or code snippets (e.g. when using `consult-gh-search-code') in preview buffer.") 386 387 (defface consult-gh-default-face 388 `((t :inherit 'default)) 389 "default face in `consult-gh''s minibuffer annotations. 390 By default, inherits from `default'.") 391 392 (defface consult-gh-user-face 393 `((t :inherit 'font-lock-constant-face)) 394 "user face in `consult-gh''s minibuffer annotations. 395 By default, inherits from `font-lock-constant-face'.") 396 397 (defface consult-gh-package-face 398 `((t :inherit 'font-lock-type-face)) 399 "packageface in `consult-gh''s minibuffer annotations. 400 By default, inherits from `font-lock-type-face'.") 401 402 (defface consult-gh-repo-face 403 `((t :inherit 'font-lock-type-face)) 404 "repository face in `consult-gh''s minibuffer annotations. 405 By default, inherits from `font-lock-type-face'.") 406 407 (defface consult-gh-issue-face 408 `((t :inherit 'warning)) 409 "issue number face in `consult-gh''s minibuffer annotations. 410 By default, inherits from `warning'.") 411 412 (defface consult-gh-pr-face 413 `((t :inherit 'warning)) 414 "pull request number face in `consult-gh''s minibuffer annotations. 415 By default, inherits from `warning'.") 416 417 418 (defface consult-gh-branch-face 419 `((t :inherit 'font-lock-string-face)) 420 "branch face in `consult-gh''s minibuffer annotations. 421 By default, inherits from `font-lock-string-face'.") 422 423 (defface consult-gh-visibility-face 424 `((t :inherit 'font-lock-warning-face)) 425 "visibility face in `consult-gh''s minibuffer annotations. 426 By default, inherits from `font-lock-warning-face'.") 427 428 (defface consult-gh-date-face 429 `((t :inherit 'font-lock-keyword-face)) 430 "date face in `consult-gh''s minibuffer annotations. 431 By default, inherits from `font-lock-keyword-face'.") 432 433 (defface consult-gh-tags-face 434 `((t :inherit 'font-lock-comment-face)) 435 "tags/comments face in `consult-gh''s minibuffer annotations. 436 By default, inherits from `font-lock-comment-face'.") 437 438 (defface consult-gh-description-face 439 `((t :inherit 'font-lock-builtin-face)) 440 "repository description face in `consult-gh''s minibuffer annotations. 441 By default, inherits from `font-lock-builtin-face'.") 442 443 (defface consult-gh-code-face 444 `((t :inherit 'font-lock-variable-use-face)) 445 "code snippets face in `consult-gh''s minibuffer annotations. 446 By default, inherits from `font-lock-vairable-use-face'.") 447 448 (defface consult-gh-url-face 449 `((t :inherit 'link)) 450 "url face in `consult-gh''s minibuffer annotations. 451 By default, inherits from `link'.") 452 453 ;;; Utility functions 454 455 (defun consult-gh--nonutf-cleanup (string) 456 "Remove non UTF-8 characters if any in the string." 457 (string-join 458 (delq nil (mapcar (lambda (ch) (encode-coding-char ch 'utf-8 'unicode)) 459 string)))) 460 461 (defun consult-gh--set-string-width (string width &optional prepend) 462 "Sets the STRING width to a fixed value, WIDTH. 463 If the String is longer than WIDTH, it truncates the string and adds an ellipsis, \"...\". If the string is shorter it adds whitespace to the string. 464 If PREPEND is non-nil, it truncates or adds whitespace from the beginning of string, instead of the end." 465 (let* ((string (format "%s" string)) 466 (w (string-width string))) 467 (when (< w width) 468 (if prepend 469 (setq string (format "%s%s" (make-string (- width w) ?\s) (substring string))) 470 (setq string (format "%s%s" (substring string) (make-string (- width w) ?\s))))) 471 (when (> w width) 472 (if prepend 473 (setq string (format "...%s" (substring string (- w (- width 3)) w))) 474 (setq string (format "%s..." (substring string 0 (- width (+ w 3))))))) 475 string)) 476 477 (defun consult-gh--justify-left (string prefix maxwidth) 478 "Sets the width of STRING+PREFIX justified from left. 479 It uses `consult-gh--set-string-width' and sets the width of the concatenated of STRING+PREFIX (e.g. `(concat prefix string)`) within MAXWIDTH or a fraction of MAXWIDTH. This is used for aligning marginalia info in minibuffer when using `consult-gh'." 480 (let ((s (string-width string)) 481 (w (string-width prefix))) 482 (cond ((< (+ s w) (floor (/ maxwidth 2))) 483 (consult-gh--set-string-width string (- (floor (/ maxwidth 2)) w) t)) 484 ((< (+ s w) (floor (/ maxwidth 1.8))) 485 (consult-gh--set-string-width string (- (floor (/ maxwidth 1.8)) w) t)) 486 ((< (+ s w) (floor (/ maxwidth 1.6))) 487 (consult-gh--set-string-width string (- (floor (/ maxwidth 1.6)) w) t)) 488 ((< (+ s w) (floor (/ maxwidth 1.4))) 489 (consult-gh--set-string-width string (- (floor (/ maxwidth 1.4)) w) t)) 490 ((< (+ s w) (floor (/ maxwidth 1.2))) 491 (consult-gh--set-string-width string (- (floor (/ maxwidth 1.2)) w) t)) 492 ((< (+ s w) maxwidth) 493 (consult-gh--set-string-width string (- maxwidth w) t)) 494 (t string) 495 ) 496 )) 497 498 (defun consult-gh--highlight-match (regexp str ignore-case) 499 "Highlights REGEXP in STR. 500 If a regular expression contains capturing groups, only these are highlighted. 501 If no capturing groups are used highlight the whole match. Case is ignored 502 if IGNORE-CASE is non-nil. 503 (This is adapted from `consult--highlight-regexps'.)" 504 (let ((i 0)) 505 (while (and (let ((case-fold-search ignore-case)) 506 (string-match regexp str i)) 507 (> (match-end 0) i)) 508 (let ((m (match-data))) 509 (setq i (cadr m) 510 m (or (cddr m) m)) 511 (while m 512 (when (car m) 513 (add-face-text-property (car m) (cadr m) 514 'consult-gh-highlight-match-face nil str)) 515 (setq m (cddr m)))))) 516 str) 517 518 (defun consult-gh--markdown-to-org-footnotes (&optional buffer) 519 "Converts Markdown style footnotes to org-mode style footnotes by regexp replacements." 520 (let ((buffer (or buffer (current-buffer)))) 521 (with-current-buffer buffer 522 (save-mark-and-excursion 523 (save-restriction 524 (goto-char (point-max)) 525 (insert "\n") 526 (while (re-search-backward "^\\[\\([^fn].*\\)\\]:" nil t) 527 (replace-match "[fn:\\1] "))))) 528 nil)) 529 530 (defun consult-gh--markdown-to-org-emphasis (&optional buffer) 531 "Converts Markdown style emphasis to org-mode style emphasis by regexp replacements." 532 (let ((buffer (or buffer (current-buffer)))) 533 (with-current-buffer buffer 534 (save-mark-and-excursion 535 (save-restriction 536 (goto-char (point-min)) 537 (when (re-search-forward "^-\\{2\\}$" nil t) 538 (delete-char -2) 539 (insert "=================================\n") 540 (replace-regexp "\\(^[a-zA-Z]+:[[:blank:]]\\)" "#+\\1" nil 0 (point-marker) nil nil)) 541 (while (re-search-forward "#\\|\\*\\{1,2\\}\\(?1:.+?\\)\\*\\{1,2\\}\\|_\\{1,2\\}\\(?2:.+?\\)_\\{1,2\\}\\|`\\(?3:[^`].+?\\)`\\|```\\(?4:.*\n\\)\\(?5:[[:ascii:][:nonascii:]]*?\\)```" nil t) 542 (pcase (match-string-no-properties 0) 543 ("#" (if (looking-at "#\\|[[:blank:]]") 544 (progn 545 (delete-char -1) 546 (insert "*")))) 547 548 ((pred (lambda (el) (string-match-p "\\*\\{1\\}[^\\*]*?\\*\\{1\\}" el))) 549 (replace-match "/\\1/")) 550 551 ((pred (lambda (el) (string-match-p "\\*\\{2\\}.+?\\*\\{2\\}" el))) 552 (replace-match "*\\1*")) 553 554 ((pred (lambda (el) (string-match-p "_\\{1\\}[^_]*?_\\{1\\}" el))) 555 (replace-match "/\\2/")) 556 557 ((pred (lambda (el) (string-match-p "_\\{2\\}.+?_\\{2\\}" el))) 558 (replace-match "*\\2*")) 559 560 ((pred (lambda (el) (string-match-p "`[^`].+?`" el))) 561 (replace-match "=\\3=")) 562 563 ((pred (lambda (el) (string-match-p "```.*\n[[:ascii:][:nonascii:]]*```" el))) 564 (replace-match "#+begin_src \\4\n\\5\n#+end_src\n"))))))) 565 nil)) 566 567 (defun consult-gh--markdown-to-org-links (&optional buffer) 568 "Converts Markdown links to org-mode links by regexp replacements." 569 (let ((buffer (or buffer (current-buffer)))) 570 (with-current-buffer buffer 571 (save-mark-and-excursion 572 (save-restriction 573 (goto-char (point-min)) 574 (while (re-search-forward "\\[\\(?1:.+?\\)\\]\\[\\]\\{1\\}\\|\\[\\(?2:.[^\\[]+?\\)\\]\\[\\(?3:.[^\\[]+?\\)\\]\\{1\\}\\|\\[\\(?4:.+?\\)\\]\(#\\(?5:.+?\\)\)\\{1\\}\\|.\\[\\(?6:.+?\\)\\]\(\\(?7:[^#].+?\\)\)\\{1\\}" nil t) 575 (pcase (match-string-no-properties 0) 576 ((pred (lambda (el) (string-match-p "\\[.+?\\]\\[\\]\\{1\\}" el))) 577 (replace-match "[fn:\\1]")) 578 579 ((pred (lambda (el) (string-match-p "\\[.[^\\[]+?\\]\\[.[^\\[]+?\\]\\{1\\}" el))) 580 (replace-match "\\2 [fn:\\3]")) 581 582 ((pred (lambda (el) (string-match-p "\\[.+?\\]\(#.+?\)\\{1\\}" el))) 583 (replace-match "[[*\\5][\\4]]")) 584 585 ((pred (lambda (el) (string-match-p "!\\[.*\\]\([^#].*\)" el))) 586 (replace-match "[[\\7][\\6]]")) 587 588 ((pred (lambda (el) (string-match-p "[[:blank:]]\\[.*\\]\([^#].*\)" el))) 589 (replace-match " [[\\7][\\6]]")))) 590 591 (goto-char (point-min)) 592 (while 593 (re-search-forward 594 "\\[fn:\\(.+?\\)\\]\\{1\\}" nil t) 595 (pcase (match-string 0) 596 ((pred (lambda (el) (string-match-p "\\[fn:.+?[[:blank:]].+?\\]\\{1\\}" (substring-no-properties el)))) 597 (progn 598 (replace-regexp-in-region "[[:blank:]]" "_" (match-beginning 1) (match-end 1))))))))) 599 nil)) 600 601 (defun consult-gh--markdown-to-org (&optional buffer) 602 "Converts from Markdown format to org-mode format. 603 This is used for viewing repos (a.k.a. fetching README file of repos) if `consult-gh-preview-buffer-mode' is set to 'org-mode." 604 (let ((buffer (or buffer (get-buffer-create consult-gh-preview-buffer-name)))) 605 (with-current-buffer buffer 606 (consult-gh--markdown-to-org-footnotes buffer) 607 (consult-gh--markdown-to-org-emphasis buffer) 608 (consult-gh--markdown-to-org-links buffer) 609 (org-mode) 610 (org-table-map-tables 'org-table-align t) 611 (org-fold-show-all) 612 (goto-char (point-min)))) 613 nil) 614 615 (defun consult-gh-recenter (&optional pos) 616 "Recenters the text in a window so that the cursor is at POS. 617 POS a symbol and can be 'top, 'bottom or 'middle. The default is 'middle so if POS is nil or anything else, the text will be centered in the middle of the window." 618 (let ((this-scroll-margin 619 (min (max 0 scroll-margin) 620 (truncate (/ (window-body-height) 4.0)))) 621 (pos (or pos 'middle))) 622 (pcase pos 623 ('middle 624 (recenter nil t)) 625 ('top 626 (recenter this-scroll-margin t)) 627 ('bottom 628 (recenter (- -1 this-scroll-margin) t)) 629 (_ 630 (recenter nil t)) 631 ))) 632 633 ;;; Backend `gh` related functions 634 635 (defun consult-gh--call-process (&rest args) 636 "Runs \"gh\" in the command line and passes ARGS as command-line arguments. 637 Returns a list where the CAR is exit status (e.g. 0 means success and non-zero means error) and CADR is the output's text. If gh is not found it returns '(127 \"\") and a message saying \"gh\" is not found." 638 (if (executable-find "gh") 639 (with-temp-buffer 640 (set-buffer-file-coding-system 'cp1047) 641 (list (apply 'call-process "gh" nil (current-buffer) nil args) 642 (replace-regexp-in-string " " "\n" 643 (buffer-string)))) 644 (progn 645 (message (propertize "\"gh\" is not found on this system" 'face 'warning)) 646 '(127 "")) 647 )) 648 649 (defun consult-gh--command-to-string (&rest args) 650 "Runs `consult-gh--call-process' and returns a string if there is no error. 651 If there are errors passes them to *Messages*." 652 (let ((out (apply #'consult-gh--call-process args))) 653 (if (= (car out) 0) 654 (cadr out) 655 (progn 656 (message (cadr out)) 657 nil) 658 ))) 659 660 (defun consult-gh--api-get-json (arg) 661 "Makes a GitHub API call to get response in JSON format by passing the ARG (e.g. a GitHub API URL) to \"gh api -H Accept:application/vnd.github+json\" command." 662 (consult-gh--call-process "api" "-H" "Accept: application/vnd.github+json" arg)) 663 664 (defun consult-gh--api-json-to-hashtable (json &optional key) 665 "Converts a JSON object to a hash table with lists for arrays and symbols for keys." 666 (let ((json-object-type 'hash-table) 667 (json-array-type 'list) 668 (json-key-type 'keyword) 669 (json-false :false)) 670 (if key 671 (gethash key (json-read-from-string json)) 672 (json-read-from-string json)))) 673 674 (defun consult-gh--get-current-username () 675 "Gets the currently logged in user by running `gh api user` and returning the login field." 676 (consult-gh--api-json-to-hashtable (cadr (consult-gh--api-get-json "user")) :login)) 677 678 (defun consult-gh--get-repo-from-directory (&optional dir) 679 "Returns the full name of the GitHub repository in the current folder (a.k.a. `default-directory') in the format \"[HOST/]OWNER/REPO\" if any, otherwise returns nil." 680 (let* ((default-directory (or dir default-directory)) 681 (response (consult-gh--call-process "repo" "view" "--json" "nameWithOwner" "--jq" ".nameWithOwner"))) 682 (if (eq (car response) 0) 683 (if (not (string-empty-p (cadr response))) 684 (string-trim (cadr response)) 685 nil) 686 nil) 687 )) 688 689 (defun consult-gh--split-repo (repo &optional separators) 690 "Splits REPO string to get user and package name. 691 Returns a list where CAR is the user's name and CADR is the package name." 692 (let ((separators (or separators "\/"))) 693 (string-split repo separators))) 694 695 (defun consult-gh--get-username (repo) 696 "Returns the username of REPO 697 (e.g. \"armindarvish\" if REPO is \"armindarvish\consult-gh\")" 698 (car (consult-gh--split-repo repo))) 699 700 (defun consult-gh--get-package (repo) 701 "Returns the package name of REPO 702 (e.g. \"consult-gh\" if REPO is \"armindarvish\consult-gh\")" 703 (cadr (consult-gh--split-repo repo))) 704 705 ;;; Backend functions for `consult-gh'. 706 707 ;; Buffers 708 (defun consult-gh-kill-preview-buffers () 709 "Kill all open preview buffers stored in `consult-gh--preview-buffers-list'. 710 It asks for confirmation if the buffer is modified and removes the buffers that are killed from the list." 711 (interactive) 712 (when consult-gh--preview-buffers-list 713 (mapcar (lambda (buff) (if (buffer-live-p buff) 714 (kill-buffer buff)) 715 (unless (buffer-live-p buff) 716 (setq consult-gh--preview-buffers-list (delete buff consult-gh--preview-buffers-list))) 717 ) consult-gh--preview-buffers-list) 718 ) 719 ) 720 721 (defun consult-gh--files-get-branches (repo) 722 "Lists branches of REPO, in json format 723 By passing REPO and \"branches\" to `consult-gh--api-get-json'." 724 (consult-gh--api-get-json (concat "repos/" repo "/branches"))) 725 726 (defun consult-gh--files-branches-hashtable-to-list (table repo) 727 "Converts a hash table, TABLE, containing name of repository branches of REPO to a list of propertized text. 728 TABLE can for example be obtained by converting the json object from `consult-gh--files-get-branches' to a hash table by using `consult-gh--api-json-to-hashtable'." 729 (mapcar (lambda (item) (cons (gethash :name item) `(:repo ,repo :branch ,(gethash :name item) :url ,(gethash :url item)))) table)) 730 731 (defun consult-gh--files-branches-list-items (repo) 732 "Gets a lit of propertized text that contains information about branches of the repository REPO on GitHub by using `consult-gh--files-get-branches', `consult-gh--files-branches-hashtable-to-list' and `consult-gh--api-json-to-hashtable'." 733 (let ((response (consult-gh--files-get-branches repo))) 734 (if (eq (car response) 0) 735 (consult-gh--files-branches-hashtable-to-list (consult-gh--api-json-to-hashtable (cadr response)) repo) 736 (message (cadr response))))) 737 738 (defun consult-gh--read-branch (repo) 739 "Queries the user to select a branch name from the list of all branches of REPO (a Github repository name in a string like \"armindarvish/consult-gh\"." 740 (pcase consult-gh-default-branch-to-load 741 ('confirm 742 (if (y-or-n-p "Load Default HEAD branch?") 743 (cons repo "HEAD") 744 (cons repo (completing-read (concat "Select Branch for " (propertize (format "\"%s\"" repo) 'face 'consult-gh-default-face) ": ") (consult-gh--files-branches-list-items repo))))) 745 ('ask 746 (cons repo (completing-read (concat "Select Branch for " (propertize (format "\"%s\"" repo) 'face 'consult-gh-default-face) ": ") (consult-gh--files-branches-list-items repo)))) 747 ('nil 748 (cons repo "HEAD")) 749 (_ 750 (cons repo (format "%s" consult-gh-default-branch-to-load))))) 751 752 ;; Files 753 (defun consult-gh--files-get-trees (repo &optional branch) 754 "Gets a recursive git \"tree\" of REPO and BRANCH in json object format by using `consult-gh--api-get-json'. " 755 (let ((branch (or branch "HEAD"))) 756 (consult-gh--api-get-json (concat "repos/" repo "/git/trees/" branch ":?recursive=1")))) 757 758 (defun consult-gh--files-table-to-list (table repo &optional branch) 759 "Converts a hashtable containing git tree information of REPO and BRANCH to a list of propertized texts formatted properly to be sent to `consult-gh-find-file'." 760 (let ((branch (or branch "HEAD"))) 761 (mapcar (lambda (item) (cons (gethash :path item) `(:repo ,repo :branch ,branch :url ,(gethash :url item) :path ,(gethash :path item) :size ,(gethash :size item)))) table))) 762 763 (defun consult-gh--files-list-items (repo &optional branch) 764 "Fetches a list of files and directories in REPO and BRANCH from GitHub api. 765 The format is propertized text that include information about the file generated by `consult-gh--files-table-to-list'. This list can be passed to `consult-gh-find-file'. 766 See `consult-gh--files-nodirectory-items' for getting a list of file but not directories. 767 " 768 (let* ((branch (or branch "HEAD")) 769 (response (consult-gh--files-get-trees repo branch)) 770 ) 771 (if (eq (car response) 0) 772 (delete-dups (consult-gh--files-table-to-list (consult-gh--api-json-to-hashtable (cadr response) :tree) repo branch)) 773 (message (cadr response))))) 774 775 (defun consult-gh--files-nodirectory-items (repo &optional branch) 776 "Fetches a list of non-directory files in REPO and BRANCH from GitHub. The format is propertized text that include information about the file generated by `consult-gh--files-table-to-list'. This list can be passed to `consult-gh-find-file'. 777 This list does not have directories. See `consult-gh--files-list-items' for getting a list of file and directories." 778 (let* ((branch (or branch "HEAD")) 779 (items (consult-gh--files-list-items repo branch)) 780 ) 781 (mapcar (lambda (item) (unless (plist-get (cdr item) :size) (setq items (delete item items)))) items) 782 items)) 783 784 (defun consult-gh--files-get-content (url) 785 "Fetches the contents of file at URL retrieved from GitHub api by `consult-gh--api-get-json' and decodes it into raw text." 786 (let* ((response (consult-gh--api-get-json url)) 787 (content (if (eq (car response) 0) (consult-gh--api-json-to-hashtable (cadr response) :content) 788 nil))) 789 (if content 790 (base64-decode-string content) 791 ""))) 792 793 (defun consult-gh--file-format (cons) 794 "Formats minibuffer candidates for files (e.g. in `consult-gh-find-file'). 795 CONS is a list of files for example returned by `consult-gh--files-nodirectory-items'." 796 (when-let* ((path (car cons)) 797 (path (string-join (mapcar (lambda (x) x) (string-split path "/")) (propertize "/" 'face 'consult-gh-default-face))) 798 (info (cdr cons)) 799 (repo (plist-get info :repo)) 800 (user (consult-gh--get-username repo)) 801 (package (consult-gh--get-package repo)) 802 (size (plist-get info :size)) 803 (branch (plist-get info :branch)) 804 (url (plist-get info :url)) 805 (str path) 806 (str (propertize str ':repo repo ':user user ':package package ':path path ':url url ':size size ':branch branch)) 807 ) 808 (cons str (list :repo repo :user user :package package :path path :url url :branch branch :size size)))) 809 810 (defun consult-gh--file-lookup () 811 "Lookup function for file candidates in `consult-gh' (e.g. in `consult-gh-find-file'). 812 This is passed as LOOKUP to `consult--read' on file candidates and is used to format the output when a candidate is selected." 813 (lambda (sel cands &rest args) 814 (let* ((info (cdr (assoc sel cands))) 815 (path (plist-get info :path))) 816 (cons path info)))) 817 818 (defun consult-gh--file-state () 819 "State function for file candidates in `consult-gh' (e.g. in `consult-gh-find-file'). 820 This is passed as STATE to `consult--read' on file candidates and is used to preview files or do other actions on the file." 821 (lambda (action cand) 822 (let* ((preview (consult--buffer-preview)) 823 ) 824 (pcase action 825 ('preview 826 (if (and consult-gh-show-preview cand) 827 (let* ((repo (plist-get (cdr cand) :repo)) 828 (path (plist-get (cdr cand) :path)) 829 (branch (or (plist-get (cdr cand) :branch) "HEAD")) 830 (url (plist-get (cdr cand) :url)) 831 (tempdir (expand-file-name (concat (make-temp-name (concat repo "/")) "/" branch "/") consult-gh-tempdir)) 832 (file-p (or (file-name-extension path) (plist-get (cdr cand) :size))) 833 (file-size (and file-p (plist-get (cdr cand) :size))) 834 (confirm (if (and file-p (>= file-size consult-gh-large-file-warning-threshold)) 835 (yes-or-no-p (format "File is %s Bytes. Do you really want to load it?" file-size)) 836 t)) 837 (prefix (concat (file-name-sans-extension (file-name-nondirectory path)))) 838 (suffix (concat "." (file-name-extension path))) 839 (temp-file (expand-file-name path tempdir)) 840 (_ (and file-p confirm (make-directory (file-name-directory temp-file) t))) 841 (text (and file-p confirm (consult-gh--files-get-content url))) 842 (_ (and file-p confirm (with-temp-file temp-file (insert text) (set-buffer-file-coding-system 'raw-text) 843 ))) 844 (buffer (or (and file-p confirm (with-temp-buffer (find-file-noselect temp-file t))) nil))) 845 (add-to-list 'consult-gh--preview-buffers-list buffer) 846 (funcall preview action 847 buffer 848 )))) 849 )) 850 )) 851 852 (defun consult-gh--file-annotate () 853 "Annotates each file candidate in the minibuffer for `consult-gh-find-file'. 854 For more info on annotation refer to `consult''s manual, particularly 'consult--read' and `consult--read-annotate' documentation." 855 (lambda (cands cand) 856 (if-let* ((info (cdr (assoc cand cands))) 857 (size (format "%s Bytes" (plist-get info :size))) 858 (repo (format "%s" (plist-get info :repo))) 859 (user (car (string-split repo "\/"))) 860 (package (cadr (string-split repo "\/"))) 861 (branch (format "%s" (plist-get info :branch))) 862 (url (format "%s" (plist-get info :url))) 863 (str (format "\s%s\s\s%s -- " 864 (propertize size 'face 'consult-gh-visibility-face) 865 (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face) "@" (propertize branch 'face 'consult-gh-branch-face)) 866 )) 867 (cand (substring-no-properties cand)) 868 ) 869 (concat 870 (consult-gh--justify-left str cand (* 1.5 (frame-width))) 871 (propertize url 'face 'consult-gh-url-face)) 872 nil) 873 )) 874 875 (defun consult-gh--file-group (cand transform) 876 "Group function for file candidate in minibuffer for consult-gh (e.g. in `consult-gh-find-file'). 877 This is passed as GROUP to `consult--read' on file candidates and is used to group files by repository names." 878 (let ((name (car (remove " " (remove "" (string-split (substring-no-properties cand) "\s\s")))))) 879 (if transform (substring cand) name))) 880 881 (defun consult-gh--files-browse-url-action (cand) 882 "Browses the url for a file candidate, CAND, from consult-gh. 883 884 This is an internal action function that gets a candidate, CAND, from `consult-gh-find-file' and opens the url of the file in a browser. To use this as the default action in `consult-gh-find-file', set `consult-gh-file-action' to #'consult-gh--files-browse-url-action." 885 (let* ((info (cdr cand)) 886 (repo (plist-get info :repo)) 887 (path (plist-get info :path)) 888 (branch (plist-get info :branch)) 889 (url (concat (string-trim (consult-gh--command-to-string "browse" "--repo" repo "--no-browser")) "/blob/" branch "/" path))) 890 (browse-url url))) 891 892 (defun consult-gh--files-view (repo path url &optional no-select tempdir jump-to-str) 893 "Opens file in an emacs buffer. 894 895 This is an internal function that gets the PATH to a file within a REPO and the URL of the file on GitHub API and puts the contents in a temporary file buffer. It fetches the content from GitHub by `consult-gh--files-get-content' and inserts it into a temporary file stored under `consult-gh-tempdir' in appropriate subdirectories for REPO. If the optional input NO-SELECT is nil, it switches to the buffer by `find-file', otherwise it does not swith-to-buffer and only returns the name of the buffer. To use this as the default action in `consult-gh-find-file', see `consult-gh--files-view-action'. 896 897 REPO is name of the repo in the format \"arimindarvish//consult-gh\" 898 PATH is the relative path of the file to the root of repo e.g. \"./README.org\" 899 URL is the url of the file as retrieved from GitHub API 900 NO-SELECT is a boolean for whether to swith-to-buffer or not 901 TEMPDIR is the directory where the temporary file is saved 902 903 Output is the buffer visiting the file." 904 (let* ((tempdir (or tempdir consult-gh-tempdir)) 905 (prefix (concat (file-name-sans-extension (file-name-nondirectory path)))) 906 (suffix (concat "." (file-name-extension path))) 907 (temp-file (expand-file-name path tempdir)) 908 (text (consult-gh--files-get-content url))) 909 (make-directory (file-name-directory temp-file) t) 910 (with-temp-file temp-file 911 (insert text) 912 (set-buffer-file-coding-system 'raw-text) 913 ) 914 (if no-select 915 (find-file-noselect temp-file) 916 (with-current-buffer (find-file temp-file) 917 (if jump-to-str 918 (progn 919 ;;(highlight-regexp (string-trim highlight-str) 'match) 920 (goto-char (point-min)) 921 (search-forward jump-to-str nil t) 922 (consult-gh-recenter 'middle)) 923 nil 924 ) 925 (add-to-list 'consult-gh--preview-buffers-list (current-buffer)) 926 ) 927 ))) 928 929 (defun consult-gh--files-view-action (cand) 930 "Opens file candidate, CAND, from consult-gh in an Emacs buffer. 931 932 This is a wrapper function around `consult-gh--files-view'. It parses CAND to extract relevant values (e.g. repository, file path, url, ...) and passes them to `consult-gh--files-view'. 933 934 To use this as the default action on consult-gh's files, set `consult-gh-file-action' to #'consult-gh--files-view-action." 935 (let* ((info (cdr cand)) 936 (repo (plist-get info :repo)) 937 (path (plist-get info :path)) 938 (url (plist-get info :url)) 939 (branch (or (plist-get info :branch) "HEAD")) 940 (consult-gh-tempdir (expand-file-name (concat (make-temp-name (format "%s/" repo)) "/" branch "/") consult-gh-tempdir)) 941 (file-p (or (file-name-extension path) (plist-get info :size))) 942 (file-size (and file-p (plist-get info :size))) 943 (confirm t)) 944 (when (>= file-size consult-gh-large-file-warning-threshold) 945 (if (yes-or-no-p (format "File is %s Bytes. Do you really want to load it?" file-size)) 946 (setq confirm t) 947 (setq confirm nil))) 948 (if (and file-p confirm) 949 (consult-gh--files-view repo path url) 950 ))) 951 952 (defun consult-gh--files-save-file-action (cand) 953 "Saves file candidate, CAND, from consult-gh to a file. 954 955 Its parses CAND to extract relevant information (e.g. repository's name, file path, url, ...) and passes them to `consult-gh--files-view', then saves the buffer to file. 956 If `consult-gh-ask-for-path-before-save' is non-nil, it queries the user for a file path, otherwise it saves the file under `consult-gh-default-save-directory' with the buffer-file-name as the name of the file. 957 958 To use this as the default action on consult-gh's files, set `consult-gh-file-action' to #'consult-gh--files-save-file-action." 959 (let* ((info (cdr cand)) 960 (repo (plist-get info :repo)) 961 (path (plist-get info :path)) 962 (url (plist-get info :url)) 963 (file-p (or (file-name-extension path) (plist-get info :size))) 964 (file-size (and file-p (plist-get info :size))) 965 (filename (and file-p (file-name-nondirectory path))) 966 (targetpath (if consult-gh-ask-for-path-before-save 967 (file-truename (read-file-name "Save As: " consult-gh-default-save-directory nil nil filename)) 968 (expand-file-name filename consult-gh-default-save-directory))) 969 (confirm t)) 970 (when (>= file-size consult-gh-large-file-warning-threshold) 971 (if (yes-or-no-p (format "File is %s Bytes. Do you really want to load it?" file-size)) 972 (setq confirm t) 973 (setq confirm nil))) 974 (let ((buffer (and file-p (consult-gh--files-view repo path url t)))) 975 (if (and file-p confirm) 976 (save-mark-and-excursion 977 (save-restriction 978 (with-current-buffer buffer 979 (write-file targetpath t)) 980 )))))) 981 982 (defun consult-gh--repo-format (string input highlight) 983 "Formats minibuffer candidates for repos (e.g. in `consult-gh-search-repos'). 984 STRING is the return of a \"gh\" call (e.g. \"gh search repos ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 985 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 986 (let* ((parts (string-split string "\t")) 987 (repo (car parts)) 988 (user (consult-gh--get-username repo)) 989 (package (consult-gh--get-package repo)) 990 (description (cadr parts)) 991 (visibility (cadr (cdr parts))) 992 (date (substring (cadr (cdr (cdr parts))) 0 10)) 993 (query input) 994 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 995 (w (string-width repo)) 996 (s (string-width visibility)) 997 (str (format "%s\s\s%s\s\s%s\s\s%s" 998 (concat 999 (propertize user 'face 'consult-gh-user-face ) 1000 "/" 1001 (propertize package 'face 'consult-gh-package-face)) 1002 (consult-gh--justify-left (propertize visibility 'face 'consult-gh-visibility-face) repo (frame-width)) 1003 (propertize (consult-gh--set-string-width date 10) 'face 'consult-gh-date-face) 1004 (propertize description 'face 'consult-gh-description-face))) 1005 (str (propertize str :repo repo :user user :package package :description description :visibility visibility :date date :query query)) 1006 ) 1007 (if (and consult-gh-highlight-matches highlight) 1008 (cond 1009 ((listp match-str) 1010 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1011 ((stringp match-str) 1012 (setq str (consult-gh--highlight-match match-str str t)))) 1013 str) 1014 (cons str (list :repo repo :user user :package package :date date :description description :visibility visibility :query query)))) 1015 1016 (defun consult-gh--repo-lookup () 1017 "Lookup function for repo candidates in consult-gh (e.g. in `consult-gh-search-repos'). 1018 This is passed as LOOKUP to `consult--read' on repo candidates and is used to format the output when a candidate is selected." 1019 (lambda (sel cands &rest args) 1020 (let* ((info (cdr (assoc sel cands))) 1021 (repo (plist-get info :repo))) 1022 (cons (format "%s" repo) info)))) 1023 1024 (defun consult-gh--repo-state () 1025 "State function for repo candidates in consult-gh (e.g. in `consult-gh-search-repos'). 1026 This is passed as STATE to `consult--read' on repo candidates and is used to preview or do other actions on the repo." 1027 (lambda (action cand) 1028 (let* ((preview (consult--buffer-preview)) 1029 ) 1030 (pcase action 1031 ('preview 1032 (if (and consult-gh-show-preview cand) 1033 (when-let ((repo (plist-get (cdr cand) :repo)) 1034 (query (plist-get (cdr cand) :query)) 1035 (match-str (consult--build-args query)) 1036 (buffer (get-buffer-create consult-gh-preview-buffer-name))) 1037 (add-to-list 'consult-gh--preview-buffers-list buffer) 1038 (consult-gh--repo-view (format "%s" repo) buffer) 1039 (with-current-buffer buffer 1040 (if consult-gh-highlight-matches 1041 (cond 1042 ((listp match-str) 1043 (mapcar (lambda (item) 1044 (highlight-regexp item 'consult-gh-preview-match-face)) match-str)) 1045 ((stringp match-str) 1046 (highlight-regexp match-str 'consult-gh-preview-match-face)) 1047 ))) 1048 (funcall preview action 1049 buffer 1050 ) 1051 ) 1052 1053 )) 1054 ('return 1055 cand) 1056 ))) 1057 ) 1058 1059 (defun consult-gh--repo-group (cand transform) 1060 "Group function for repo candidates in minibuffer for consult-gh (e.g. in `consult-gh-search-repos'). 1061 This is passed as GROUP to `consult--read' on file candidates and is used to group repos by user\owner's names." 1062 (let ((name (car (string-split (replace-regexp-in-string " " "" (format "%s" (car (remove " " (remove "" (string-split (substring-no-properties cand) "\s")))) "/")) "/"))) 1063 ) 1064 (if transform (substring cand) name))) 1065 1066 (defun consult-gh--repo-browse-url-action (cand) 1067 "Browses the url for a repo candidate, CAND, from consult-gh. 1068 1069 This is an internal action function that gets a candidate, CAND, for example from `consult-gh-search-repos' and opens the url of the repo in an external browser. To use this as the default action for repos, set `consult-gh-repo-action' to #'consult-gh--repo-browse-url-action." 1070 (let* ((response (consult-gh--call-process "browse" "--repo" (substring-no-properties cand) "--no-browser")) 1071 (url (string-trim (cadr response)))) 1072 (if (eq (car response) 0) 1073 (browse-url url) 1074 (message url)) 1075 )) 1076 1077 (defun consult-gh--repo-view (repo &optional buffer) 1078 "Opens REPO's Readme in an Emacs buffer, BUFFER. 1079 1080 This is an internal function that gets takes REPO, the name of a GitHub repository for example \"armindarvish\consult-gh\" and shows the README of that repo in an Emacs buffer. It fetches the preview from GitHub by `gh repo view REPO` and puts the response as raw text in the buffer defined by optional input, BUFFER, or if BUFFER is nil, in a buffer named by `consult-gh-preview-buffer-name'. If `consult-gh-preview-buffer-mode' is set to either 'markdown-mode or 'org-mode, it sets the major mode of the buffer accordingly otherwise it shows the raw text in fundamental-mode. 1081 1082 REPO is the name of the repository to be previewed. 1083 BUFFER is an optional buffer the preview should be shown in. 1084 1085 " 1086 (let ((buffer (or buffer (get-buffer-create consult-gh-preview-buffer-name))) 1087 (text (cadr (consult-gh--call-process "repo" "view" repo)))) 1088 (with-current-buffer buffer 1089 (erase-buffer) 1090 (insert text) 1091 (goto-char (point-min-marker)) 1092 (pcase consult-gh-preview-buffer-mode 1093 ('markdown-mode 1094 (if (featurep 'markdown-mode) 1095 (progn 1096 (require 'markdown-mode) 1097 (markdown-mode) 1098 (markdown-display-inline-images)) 1099 (message "markdown-mode not available"))) 1100 ('org-mode 1101 (let ((org-display-remote-inline-images 'download)) 1102 (consult-gh--markdown-to-org buffer) 1103 )) 1104 (_ ())) 1105 ) 1106 )) 1107 1108 (defun consult-gh--repo-view-action (cand) 1109 "Opens the preview of a repo candidate, CAND, from consult-gh in an Emacs buffer. 1110 1111 This is a wrapper function around `consult-gh--repo-view'. It parses CAND to extract relevant values (e.g. repository's name) and passes them to `consult-gh--repo-view'. 1112 1113 To use this as the default action for consult-gh's repos, set `consult-gh-repo-action' to #'consult-gh--repo-view-action." 1114 1115 (let* ((repo (substring-no-properties cand)) 1116 (buffername (concat (string-trim consult-gh-preview-buffer-name "" "*") ":" repo "*"))) 1117 (consult-gh--repo-view repo) 1118 (switch-to-buffer (get-buffer-create consult-gh-preview-buffer-name)) 1119 (rename-buffer buffername t) 1120 )) 1121 1122 (defun consult-gh--repo-browse-files-action (cand) 1123 "Browse file tree of a repo candidate, CAND, from consult-gh. 1124 1125 Opens the preview of a repo candidate, CAND, from consult-gh in an Emacs buffer. 1126 1127 This is a wrapper function around `consult-gh-find-file'. It parses CAND to extract relevant values (e.g. repository's name) and passes them to `consult-gh-find-file'. 1128 1129 To use this as the default action for consult-gh's repos, set `consult-gh-repo-action' to #'consult-gh--repo-browse-files-action." 1130 (let* ((repo (plist-get (cdr cand) :repo))) 1131 (consult-gh-find-file repo) 1132 )) 1133 1134 (defvar consult-gh-repo-post-clone-hook nil 1135 "Function(s) called after `consult-gh--repo-clone'. 1136 Full path of the cloned repo is passed to these functions as input arg.") 1137 1138 (defun consult-gh--repo-clone (repo name targetdir &rest args) 1139 "Clones REPO to the path TARGETDIR/NAME. 1140 This is an internal function for non-interactive use. For interactive use see `consult-gh-repo-clone'. It calls \"gh\" in the command line and runs `gh clone REPO TARGETDIR/NAME`." 1141 (if (consult-gh--command-to-string "repo" "clone" (format "%s" repo) (expand-file-name name targetdir)) 1142 (progn 1143 (run-hook-with-args 'consult-gh-repo-post-clone-hook (expand-file-name name targetdir)) 1144 (message (format "repo %s was cloned to %s" (propertize repo 'face 'font-lock-keyword-face) (propertize (expand-file-name name targetdir) 'face 'font-lock-type-face))))) 1145 (let ((inhibit-message t)) 1146 (expand-file-name name targetdir)) 1147 ) 1148 1149 (defun consult-gh--repo-clone-action (cand) 1150 "Clones a repo candidate, CAND, from consult-gh. 1151 1152 This is a wrapper function around `consult-gh--repo-clone'. It parses CAND to extract relevant values (e.g. repository's name) and passes them to `consult-gh--repo-clone'. 1153 1154 To use this as the default action for consult-gh's repos, set `consult-gh-repo-action' to #'consult-gh--repo-clone-action. 1155 1156 If `consult-gh-confirm-before-clone' is nil it clones the repo under `consult-gh-default-clone-directory' and uses the package name from REPO as the default name for the cloned folder." 1157 1158 (let* ((reponame (plist-get (cdr cand) :repo)) 1159 (package (car (last (split-string reponame "\/"))))) 1160 (if consult-gh-confirm-before-clone 1161 (let* ((targetdir (read-directory-name (concat "Select Directory for " (propertize (format "%s: " reponame) 'face 'font-lock-keyword-face)) (or consult-gh-default-clone-directory default-directory) default-directory)) 1162 (name (read-string "name: " package))) 1163 (consult-gh--repo-clone reponame name targetdir)) 1164 (consult-gh--repo-clone reponame package consult-gh-default-clone-directory)) 1165 )) 1166 1167 (defvar consult-gh-repo-post-fork-hook nil 1168 "Function(s) called after `consult-gh--repo-fork'. 1169 Full name of the forked repo e.g. \"armindarvish/consult-gh\" is passed to these functions as input arg.") 1170 1171 (defun consult-gh--repo-fork (repo &optional name) 1172 "Forks REPO as NAME. 1173 This is an internal function for non-interactive use. For interactive use see `consult-gh-repo-fork'. It calls gh in the command line and runs `gh fork REPO --fork-name NAME`." 1174 (let* ((package (car (last (split-string repo "\/")))) 1175 (name (or name package)) 1176 (forkrepo (concat (consult-gh--get-current-username) "/" name))) 1177 (consult-gh--command-to-string "repo" "fork" (format "%s" repo) "--fork-name" name) 1178 (message (format "repo %s was forked to %s" (propertize repo 'face 'font-lock-keyword-face) (propertize forkrepo 'face 'font-lock-warning-face))) 1179 (run-hook-with-args 'consult-gh-repo-post-fork-hook forkrepo) 1180 (let ((inhibit-message t)) 1181 forkrepo) 1182 )) 1183 1184 1185 (defun consult-gh--repo-fork-action (cand) 1186 "Forks a repo candidate, CAND, from consult-gh. 1187 1188 This is a wrapper function around `consult-gh--repo-fork. It parses CAND to extract relevant values (e.g. repository's name) and passes them to `consult-gh--repo-fork'. 1189 1190 To use this as the default action for consult-gh's repos, set `consult-gh-repo-action' to #'consult-gh--repo-fork-action." 1191 (let* ((reponame (plist-get (cdr cand) :repo))) 1192 (consult-gh--repo-fork reponame) 1193 )) 1194 1195 (defun consult-gh--issue-list-format (string input highlight) 1196 "Formats minibuffer candidates for issues (e.g. specifically for `consult-gh-issue-list'). 1197 STRING is the return of a \"gh\" call (e.g. \"gh issue list ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 1198 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 1199 1200 (let* ((parts (string-split string "\t")) 1201 (repo input) 1202 (user (consult-gh--get-username repo)) 1203 (package (consult-gh--get-package repo)) 1204 (issue (car parts)) 1205 (state (upcase (cadr parts))) 1206 (face (pcase state 1207 ("CLOSED" 'consult-gh-success-face) 1208 ("OPEN" 'consult-gh-warning-face) 1209 (_ 'consult-gh-issue-face) 1210 )) 1211 (title (cadr (cdr parts))) 1212 (tags (cadr (cdr (cdr parts)))) 1213 (date (substring (cadr (cdr (cdr (cdr parts)))) 0 10)) 1214 (query input) 1215 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 1216 (str (format "%s\s\s%s\s\s%s\s\s%s\s\s%s" 1217 (consult-gh--set-string-width (concat (propertize (format "%s" issue) 'face face) ":" (propertize (format "%s" title) 'face 'consult-gh-default-face)) 70) 1218 (propertize (consult-gh--set-string-width state 8) 'face face) 1219 (propertize (consult-gh--set-string-width date 10) 'face 'consult-gh-date-face) 1220 (propertize (consult-gh--set-string-width tags 24) 'face 'consult-gh-tags-face) 1221 (consult-gh--set-string-width (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face)) 40))) 1222 (str (propertize str :repo repo :user user :package package :issue issue :state state :title title :tags tags :date date :query query)) 1223 (str (if highlight (consult-gh--highlight-match repo str t) str)) 1224 ) 1225 (if (and consult-gh-highlight-matches highlight) 1226 (cond 1227 ((listp match-str) 1228 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1229 ((stringp match-str) 1230 (setq str (consult-gh--highlight-match match-str str t)))) 1231 str) 1232 (cons str (list :repo repo :user user :package package :issue issue :state state :title title :tags tags :date date :query query)))) 1233 1234 (defun consult-gh--search-issues-format (string input highlight) 1235 "Formats minibuffer candidates for issues (e.g. specifically for `consult-gh-search-issues'). 1236 STRING is the return of a \"gh\" call (e.g. \"gh search issues ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 1237 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 1238 (let* ((parts (string-split string "\t")) 1239 (repo (car parts)) 1240 (user (consult-gh--get-username repo)) 1241 (package (consult-gh--get-package repo)) 1242 (issue (cadr parts)) 1243 (state (upcase (cadr (cdr parts)))) 1244 (face (pcase state 1245 ("CLOSED" 'consult-gh-success-face) 1246 ("OPEN" 'consult-gh-warning-face) 1247 (_ 'consult-gh-issue-face) 1248 )) 1249 (title (cadr (cdr (cdr parts)))) 1250 (tags (cadr (cdr (cdr (cdr parts))))) 1251 (date (substring (cadr (cdr (cdr (cdr (cdr parts))))) 0 10)) 1252 (query input) 1253 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 1254 (str (format "%s\s\s%s\s\s%s\s\s%s\s\s%s" 1255 (consult-gh--set-string-width (concat (propertize (format "%s" issue) 'face face) ":" (propertize (format "%s" title) 'face 'consult-gh-default-face)) 80) 1256 (propertize (consult-gh--set-string-width state 8) 'face face) 1257 (propertize (consult-gh--set-string-width date 10) 'face 'consult-gh-date-face) 1258 (propertize (consult-gh--set-string-width tags 24) 'face 'consult-gh-tags-face) 1259 (consult-gh--set-string-width (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face)) 40) 1260 )) 1261 (str (propertize str :repo repo :user user :package package :issue issue :state state :title title :tags tags :date date :query query)) 1262 ) 1263 (if (and consult-gh-highlight-matches highlight) 1264 (cond 1265 ((listp match-str) 1266 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1267 ((stringp match-str) 1268 (setq str (consult-gh--highlight-match match-str str t)))) 1269 str) 1270 (cons str (list :repo repo :user user :issue issue :state state :title title :tags tags :date date :query query)))) 1271 1272 (defun consult-gh--issue-lookup () 1273 "Lookup function for issue candidates in `consult-gh' (e.g. in `consult-gh-search-issues'). 1274 This is passed as LOOKUP to `consult--read' on issue candidates and is used to format the output when a candidate is selected." 1275 (lambda (sel cands &rest args) 1276 (let* ((info (cdr (assoc sel cands))) 1277 (title (plist-get info :title)) 1278 (issue (plist-get info :issue))) 1279 (cons (format "%s:%s" issue title) info)))) 1280 1281 (defun consult-gh--issue-state () 1282 "State function for issue candidates in consult-gh (e.g. in `consult-gh-search-issues'). 1283 This is passed as STATE to `consult--read' on issue candidates and is used to preview or do other actions on the issue." 1284 (lambda (action cand) 1285 (let* ((preview (consult--buffer-preview)) 1286 ) 1287 (pcase action 1288 ('preview 1289 (if (and consult-gh-show-preview cand) 1290 (when-let ((repo (plist-get (cdr cand) :repo)) 1291 (query (plist-get (cdr cand) :query)) 1292 (issue (plist-get (cdr cand) :issue)) 1293 (match-str (consult--build-args query)) 1294 (buffer (get-buffer-create consult-gh-preview-buffer-name))) 1295 (add-to-list 'consult-gh--preview-buffers-list buffer) 1296 (consult-gh--issue-view (format "%s" repo) (format "%s" issue) buffer) 1297 (with-current-buffer buffer 1298 (if consult-gh-highlight-matches 1299 (cond 1300 ((listp match-str) 1301 (mapcar (lambda (item) 1302 (highlight-regexp item 'consult-gh-preview-match-face)) match-str)) 1303 ((stringp match-str) 1304 (highlight-regexp match-str 'consult-gh-preview-match-face)) 1305 ))) 1306 (funcall preview action 1307 buffer 1308 )) 1309 )) 1310 ('return 1311 cand) 1312 ))) 1313 ) 1314 1315 (defun consult-gh--issue-group-by-state (cand transform) 1316 "Group function for issue candidates in minibuffer for consult-gh (e.g. `consult-gh-issue-list'). 1317 This is passed as GROUP to `consult--read' on issue candidates and is used to group issues by their state e.g. \"OPEN\" or \"CLOSED\"." 1318 (let ((name (replace-regexp-in-string " " "" (format "%s" (cadr (remove " " (remove "" (string-split (substring-no-properties cand) "\s\s")))))))) 1319 (if transform (substring cand) name))) 1320 1321 (defun consult-gh--issue-group-by-repo (cand transform) 1322 "Group function for issue candidates in minibuffer for consult-gh (e.g. `consult-gh-issue-list'). 1323 This is passed as GROUP to `consult--read' on issue candidates and is used to group issues by repository names." 1324 (let ((name (car (last (remove " " (remove "" (string-split (substring-no-properties cand) "\s\s"))))))) 1325 (if transform (substring cand) name))) 1326 1327 (defun consult-gh--issue-browse-url-action (cand) 1328 "Browses the url for an issue candidate, CAND, from consult-gh. 1329 This is an internal action function that gets a candidate, CAND, for example from `consult-gh-search-issues' and opens the url of the issue in an external browser. To use this as the default action for issues, set `consult-gh-issue-action' to #'consult-gh--issue-browse-url-action." 1330 (let* ((info (cdr cand)) 1331 (repo (substring-no-properties (plist-get info :repo))) 1332 (issue (substring-no-properties (plist-get info :issue)))) 1333 (consult-gh--call-process "issue" "view" "--repo" repo "--web" issue))) 1334 1335 (defun consult-gh--issue-view (repo issue &optional buffer) 1336 "Opens ISSUE of REPO in an Emacs buffer, BUFFER. 1337 1338 This is an internal function that takes REPO, the name of a GitHub repository for example \"armindarvish\consult-gh\" and ISSUE, a GitHub issue number of that repository, and shows the contents of the issue in an Emacs buffer. It fetches the preview of the ISSUE from GitHub by `gh issue view ISSUE --repo REPO` and puts the response as raw text in the buffer defined by the optional input arg BUFFER or if BUFFER is nil, in a buffer named appropriately from `consult-gh-preview-buffer-name'. If `consult-gh-preview-buffer-mode' is set to either 'markdown-mode or 'org-mode, it sets the major mode of the buffer accordingly otherwise it shows the raw text in fundamental-mode. 1339 1340 REPO is the name of the repository to be previewed. 1341 ISSUE is the issue number 1342 BUFFER is an optional buffer the preview should be shown in. 1343 1344 To use this as the default action for repos, see `consult-gh--issue-view-action'. 1345 " 1346 (let ((buffer (or buffer (get-buffer-create consult-gh-preview-buffer-name))) 1347 (text-main (cadr (consult-gh--call-process "issue" "view" issue "--repo" repo))) 1348 (text-comments (cadr (consult-gh--call-process "issue" "view" issue "--repo" repo "--comments")))) 1349 (with-current-buffer buffer 1350 (erase-buffer) 1351 (insert (string-trim text-main)) 1352 (insert "\n--\n") 1353 (insert (string-trim text-comments)) 1354 (goto-char (point-min-marker)) 1355 (pcase consult-gh-preview-buffer-mode 1356 ('markdown-mode 1357 (if (featurep 'markdown-mode) 1358 (progn 1359 (markdown-mode) 1360 (markdown-display-inline-images)) 1361 (message "markdown-mode not available"))) 1362 ('org-mode 1363 (let ((org-display-remote-inline-images 'download)) 1364 (consult-gh--markdown-to-org buffer) 1365 )) 1366 (_ ())) 1367 ) 1368 )) 1369 1370 (defun consult-gh--issue-view-action (cand) 1371 "Opens the preview of an issue candidate, CAND, from consult-gh in an Emacs buffer. 1372 1373 This is a wrapper function around `consult-gh--issue-view'. It parses CAND to extract relevant values (e.g. repository's name and issue number) and passes them to `consult-gh--issue-view'. 1374 1375 To use this as the default action for consult-gh's issues, set `consult-gh-issue-action' to #'consult-gh--issue-view-action." 1376 (let* ((info (cdr cand)) 1377 (repo (substring-no-properties (plist-get info :repo))) 1378 (issue (substring-no-properties (format "%s" (plist-get info :issue)))) 1379 (buffername (concat (string-trim consult-gh-preview-buffer-name "" "*") ":" repo "/issues/" issue "*"))) 1380 (consult-gh--issue-view repo issue) 1381 (switch-to-buffer (get-buffer-create consult-gh-preview-buffer-name)) 1382 (rename-buffer buffername t) 1383 )) 1384 1385 (defun consult-gh--pr-list-format (string input highlight) 1386 "Formats minibuffer candidates for pull requests (e.g. specifically for `consult-gh-pr-list'). 1387 STRING is the return of a \"gh\" call (e.g. \"gh pr list ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 1388 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 1389 (let* ((parts (string-split string "\t")) 1390 (repo input) 1391 (user (consult-gh--get-username repo)) 1392 (package (consult-gh--get-package repo)) 1393 (pr (car parts)) 1394 (state (upcase (cadr (cdr (cdr parts))))) 1395 (face (pcase state 1396 ("CLOSED" 'consult-gh-error-face) 1397 ("MERGED" 'consult-gh-success-face) 1398 ("OPEN" 'consult-gh-repo-face) 1399 (_ 'consult-gh-pr-face) 1400 )) 1401 (branch (cadr (cdr parts))) 1402 (title (cadr parts)) 1403 (date (substring (cadr (cdr (cdr (cdr parts)))) 0 10)) 1404 (query input) 1405 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 1406 (str (format "%s\s\s%s\s\s%s\s\s%s\s\s%s" 1407 (consult-gh--set-string-width (concat (propertize (format "%s" pr) 'face face) ":" (propertize (format "%s" title) 'face 'consult-gh-default-face)) 70) 1408 (propertize (consult-gh--set-string-width state 8) 'face face) 1409 (propertize (consult-gh--set-string-width date 10) 'face 'consult-gh-date-face) 1410 (propertize (consult-gh--set-string-width branch 24) 'face 'consult-gh-branch-face) 1411 (consult-gh--set-string-width (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face)) 40))) 1412 (str (propertize str :repo repo :user user :package package :pr pr :state state :title title :branch branch :date date :query query)) 1413 ) 1414 (if (and consult-gh-highlight-matches highlight) 1415 (cond 1416 ((listp match-str) 1417 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1418 ((stringp match-str) 1419 (setq str (consult-gh--highlight-match match-str str t)))) 1420 str) 1421 (cons str (list :repo repo :user user :package package :pr pr :state state :title title :branch branch :date date :query query)))) 1422 1423 (defun consult-gh--search-prs-format (string input highlight) 1424 "Formats minibuffer candidates for pull requests (e.g. specifically for `consult-gh-search-prs'). 1425 STRING is the return of a \"gh\" call (e.g. \"gh search prs ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 1426 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 1427 1428 (let* ((parts (string-split string "\t")) 1429 (repo (car parts)) 1430 (user (consult-gh--get-username repo)) 1431 (package (consult-gh--get-package repo)) 1432 (pr (cadr parts)) 1433 (state (upcase (cadr (cdr parts)))) 1434 (face (pcase state 1435 ("CLOSED" 'consult-gh-error-face) 1436 ("MERGED" 'consult-gh-success-face) 1437 ("OPEN" 'consult-gh-repo-face) 1438 (_ 'consult-gh-pr-face) 1439 )) 1440 (title (cadr (cdr (cdr parts)))) 1441 (tags (cadr (cdr (cdr (cdr parts))))) 1442 (date (substring (cadr (cdr (cdr (cdr (cdr parts))))) 0 10)) 1443 (query input) 1444 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 1445 (str (format "%s\s\s%s\s\s%s\s\s%s\s\s%s" 1446 (consult-gh--set-string-width (concat (propertize (format "%s" pr) 'face face) ":" (propertize (format "%s" title) 'face 'consult-gh-default-face)) 70) 1447 (propertize (consult-gh--set-string-width state 8) 'face face) 1448 (propertize (consult-gh--set-string-width date 10) 'face 'consult-gh-date-face) 1449 (propertize (consult-gh--set-string-width tags 40) 'face 'consult-gh-tags-face) 1450 (consult-gh--set-string-width (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face)) 40))) 1451 (str (propertize str :repo repo :user user :package package :pr pr :state state :title title :tags tags :date date :query query)) 1452 ) 1453 (if (and consult-gh-highlight-matches highlight) 1454 (cond 1455 ((listp match-str) 1456 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1457 ((stringp match-str) 1458 (setq str (consult-gh--highlight-match match-str str t)))) 1459 str) 1460 (cons str (list :repo repo :user user :pr pr :state state :title title :tags tags :date date :query query)))) 1461 1462 (defun consult-gh--pr-lookup () 1463 "Lookup function for pr candidates in `consult-gh' (e.g. in `consult-gh-search-prs'). 1464 This is passed as LOOKUP to `consult--read' on pr candidates and is used to format the output when a candidate is selected." 1465 (lambda (sel cands &rest args) 1466 (let* ((info (cdr (assoc sel cands))) 1467 (title (plist-get info :title)) 1468 (pr (plist-get info :pr))) 1469 (cons (format "%s:%s" pr title) info)))) 1470 1471 (defun consult-gh--pr-state () 1472 "State function for pull request candidates in consult-gh (e.g. in `consult-gh-search-prs'). 1473 This is passed as STATE to `consult--read' on pr candidates and is used to preview or do other actions on the pr." 1474 (lambda (action cand) 1475 (let* ((preview (consult--buffer-preview)) 1476 ) 1477 (if cand 1478 (pcase action 1479 ('preview 1480 (if (and consult-gh-show-preview cand) 1481 (when-let ((repo (plist-get (cdr cand) :repo)) 1482 (pr (plist-get (cdr cand) :pr)) 1483 (query (plist-get (cdr cand) :query)) 1484 (match-str (consult--build-args query)) 1485 (buffer (get-buffer-create consult-gh-preview-buffer-name))) 1486 (add-to-list 'consult-gh--preview-buffers-list buffer) 1487 (consult-gh--pr-view repo pr buffer) 1488 (with-current-buffer buffer 1489 (if consult-gh-highlight-matches 1490 (cond 1491 ((listp match-str) 1492 (mapcar (lambda (item) 1493 (highlight-regexp item 'consult-gh-preview-match-face)) match-str)) 1494 ((stringp match-str) 1495 (highlight-regexp match-str 'consult-gh-preview-match-face)) 1496 ))) 1497 (funcall preview action 1498 buffer 1499 )) 1500 ) 1501 ) 1502 ('return 1503 cand) 1504 ))) 1505 )) 1506 1507 (defun consult-gh--pr-group-by-state (cand transform) 1508 "Group function for pull request candidates in minibuffer for consult-gh (e.g. `consult-gh-pr-list'). 1509 This is passed as GROUP to `consult--read' on pr candidates and is used to group prs by their state e.g. \"OPEN\", \"MERGED\", or \"CLOSED\"." 1510 (let ((name (replace-regexp-in-string " " "" (format "%s" (cadr (remove " " (remove "" (string-split (substring-no-properties cand) "\s\s")))))))) 1511 (if transform (substring cand) name))) 1512 1513 (defun consult-gh--pr-group-by-repo (cand transform) 1514 "Group function for pull request candidates in minibuffer for consult-gh (e.g. `consult-gh-issue-list'). 1515 This is passed as GROUP to `consult--read' on pr candidates and is used to group prs by repository names." 1516 (let ((name (car (last (remove " " (remove "" (string-split (substring-no-properties cand) "\s\s"))))))) 1517 (if transform (substring cand) name))) 1518 1519 (defun consult-gh--pr-browse-url-action (cand) 1520 "Browses the url for a pull request candidate, CAND, from consult-gh. 1521 This is an internal action function that gets a candidate, CAND, for example from `consult-gh-search-prs' and opens the url of the pr in an external browser. To use this as the default action for prs, set `consult-gh-pr-action' to #'consult-gh--pr-browse-url-action." 1522 (let* ((info (cdr cand)) 1523 (repo (substring-no-properties (plist-get info :repo))) 1524 (pr (substring-no-properties (plist-get info :pr)))) 1525 (consult-gh--call-process "pr" "view" "--repo" repo "--web" pr))) 1526 1527 (defun consult-gh--pr-view (repo pr &optional buffer) 1528 "Opens pull request, PR of REPO in an Emacs buffer, BUFFER. 1529 1530 This is an internal function that takes REPO, the name of a GitHub repository for example \"armindarvish\consult-gh\" and ISSUE, a pr number, and shows the contents of the pr in an Emacs buffer. It fetches the preview of the PR from GitHub by `gh or view PR --repo REPO` and puts the response as raw text in the buffer defined by the optional input arg BUFFER, or if BUFFER is nil, in a buffer named appropriately from `consult-gh-preview-buffer-name'. If `consult-gh-preview-buffer-mode' is set to either 'markdown-mode or 'org-mode, it sets the major mode of the buffer accordingly otherwise it shows the raw text in fundamental-mode. 1531 1532 REPO is the name of the repository to be previewed. 1533 PR is the pull request number 1534 BUFFER is an optional buffer the preview should be shown in. 1535 1536 To use this as the default action for PRs, see `consult-gh--pr-view-action'. 1537 " 1538 (let ((buffer (or buffer (get-buffer-create consult-gh-preview-buffer-name))) 1539 (text-main (cadr (consult-gh--call-process "pr" "view" pr "--repo" repo))) 1540 (text-comments (cadr (consult-gh--call-process "pr" "view" pr "--repo" repo "--comments")))) 1541 (with-current-buffer buffer 1542 (erase-buffer) 1543 (insert (string-trim text-main)) 1544 (insert "\n--\n") 1545 (insert (string-trim text-comments)) 1546 (goto-char (point-min-marker)) 1547 (pcase consult-gh-preview-buffer-mode 1548 ('markdown-mode 1549 (if (featurep 'markdown-mode) 1550 (progn 1551 (markdown-mode) 1552 (markdown-display-inline-images)) 1553 (message "markdown-mode not available"))) 1554 ('org-mode 1555 (let ((org-display-remote-inline-images 'download)) 1556 (consult-gh--markdown-to-org buffer) 1557 )) 1558 (_ ())) 1559 ) 1560 )) 1561 1562 (defun consult-gh--pr-view-action (cand) 1563 "Opens the preview of a pull request candidate, CAND, from consult-gh in an Emacs buffer. 1564 1565 This is a wrapper function around `consult-gh--pr-view'. It parses CAND to extract relevant values (e.g. repository's name and pull request number) and passes them to `consult-gh--pr-view'. 1566 1567 To use this as the default action for consult-gh's prs, set `consult-gh-pr-action' to #'consult-gh--pr-view-action." 1568 (let* ((info (cdr cand)) 1569 (repo (substring-no-properties (plist-get info :repo))) 1570 (pr (substring-no-properties (format "%s" (plist-get info :pr)))) 1571 (buffername (concat (string-trim consult-gh-preview-buffer-name "" "*") ":" repo "/pull/" pr "*"))) 1572 (consult-gh--pr-view repo pr) 1573 (switch-to-buffer (get-buffer-create consult-gh-preview-buffer-name)) 1574 (rename-buffer buffername t) 1575 )) 1576 1577 (defun consult-gh--search-code-format (string input highlight) 1578 "Formats minibuffer candidates for code (e.g. for `consult-gh-search-code'). 1579 STRING is the return of a \"gh\" call (e.g. \"gh search code ...\"). INPUT is the query from the user (a.k.a. command line argument passed to the gh call). 1580 If HIGHLIGHT is t, input is highlighted with `consult-gh-highlight-match-face' in the minibuffer." 1581 (let* ((parts (string-split string ":")) 1582 (repo (car parts)) 1583 (user (consult-gh--get-username repo)) 1584 (package (consult-gh--get-package repo)) 1585 (path (format "%s" (cadr parts))) 1586 (url (format "repos/%s/contents/%s" repo path)) 1587 (path (concat "./" path)) 1588 (code (mapcar (lambda (x) (replace-regexp-in-string "\t" "\s\s" (replace-regexp-in-string "\n" "\\n" (format "%s" x)))) (cdr (cdr parts)))) 1589 (code (string-join code ":")) 1590 (query input) 1591 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil)) 1592 (str (format "%s\t%s\t%s" 1593 (consult-gh--set-string-width (propertize code 'face 'consult-gh-code-face) 100) 1594 (propertize path 'face 'consult-gh-url-face) 1595 (consult-gh--set-string-width (concat (propertize user 'face 'consult-gh-user-face ) "/" (propertize package 'face 'consult-gh-package-face)) 40))) 1596 (str (propertize str ':repo repo ':user user ':package package ':code code ':path path ':url url ':query query)) 1597 ) 1598 (if (and consult-gh-highlight-matches highlight) 1599 (cond 1600 ((listp match-str) 1601 (mapcar (lambda (match) (setq str (consult-gh--highlight-match match str t))) match-str)) 1602 ((stringp match-str) 1603 (setq str (consult-gh--highlight-match match-str str t)))) 1604 str) 1605 (cons str (list :repo repo :user user :package package :code code :path path :url url :query query)))) 1606 1607 (defun consult-gh--code-lookup () 1608 "Lookup function for code candidates in `consult-gh' (e.g. in `consult-gh-search-code'). 1609 This is passed as LOOKUP to `consult--read' on code candidates and is used to format the output when a candidate is selected." 1610 (lambda (sel cands &rest args) 1611 (if-let* ((info (cdr (assoc sel cands))) 1612 (repo (plist-get info :repo)) 1613 (path (plist-get info :path))) 1614 (cons (format "%s:%s" repo path) info) 1615 nil))) 1616 1617 (defun consult-gh--code-state () 1618 "State function for code candidates in consult-gh (e.g. in `consult-gh-search-code'). 1619 This is passed as STATE to `consult--read' on code candidates and is used to preview or do other actions on the code." 1620 (lambda (action cand) 1621 (let* ((preview (consult--buffer-preview)) 1622 ) 1623 (if cand 1624 (pcase action 1625 ('preview 1626 (if (and consult-gh-show-preview cand) 1627 (let* ((repo (plist-get (cdr cand) :repo)) 1628 (path (plist-get (cdr cand) :path)) 1629 (branch (or (plist-get (cdr cand) :branch) "HEAD")) 1630 (query (plist-get (cdr cand) :query)) 1631 (code (plist-get (cdr cand) :code)) 1632 (url (plist-get (cdr cand) :url)) 1633 (tempdir (expand-file-name (concat (make-temp-name (concat repo "/")) "/" branch "/") consult-gh-tempdir)) 1634 (prefix (concat (file-name-sans-extension (file-name-nondirectory path)))) 1635 (suffix (concat "." (file-name-extension path))) 1636 (temp-file (expand-file-name path tempdir)) 1637 (_ (make-directory (file-name-directory temp-file) t)) 1638 (text (consult-gh--files-get-content url)) 1639 (_ (with-temp-file temp-file (insert text) (set-buffer-file-coding-system 'raw-text) 1640 )) 1641 (buffer (or (with-temp-buffer (find-file-noselect temp-file t)) 1642 nil))) 1643 (when buffer 1644 (with-current-buffer buffer 1645 (if consult-gh-highlight-matches 1646 (highlight-regexp (string-trim code) 'consult-gh-preview-match-face)) 1647 (goto-char (point-min)) 1648 (search-forward code nil t) 1649 (add-to-list 'consult-gh--preview-buffers-list buffer) 1650 (funcall preview action 1651 buffer 1652 ) 1653 (consult-gh-recenter 'middle)) 1654 ) 1655 ) 1656 )) 1657 ('return 1658 cand) 1659 ))) 1660 )) 1661 1662 (defun consult-gh--code-group (cand transform) 1663 "Group function for code candidates in minibuffer for consult-gh (e.g. in `consult-gh-search-code'). 1664 This is passed as GROUP to `consult--read' on code candidates and is used to group code results by repository names." 1665 (let ((repo (car (last (remove "" (string-split (substring-no-properties cand) "\t" t "\s*"))))) 1666 (path (replace-regexp-in-string "\t" "" (format "%s" (cadr (remove "\t" (remove "" (string-split (substring-no-properties cand) "\t" t "\s")))))))) 1667 (if transform (substring cand) (format "%s -- %s" repo path)))) 1668 1669 (defun consult-gh--code-browse-url-action (cand) 1670 "Browses the url for a code candidate, CAND, from consult-gh. 1671 This is an internal action function that gets a candidate, CAND, for example from `consult-gh-search-code' and opens the url of the file containing the code in an external browser. To use this as the default action for code, set `consult-gh-code-action' to #'consult-gh--code-browse-url-action." 1672 (let* ((info (cdr cand)) 1673 (repo (substring-no-properties (plist-get info :repo))) 1674 (path (substring-no-properties (plist-get info :path))) 1675 (url (concat (string-trim (consult-gh--command-to-string "browse" "--repo" repo "--no-browser")) "/blob/HEAD/" path))) 1676 (browse-url url))) 1677 1678 (defun consult-gh--code-view-action (cand) 1679 "Opens code candidate, CAND, from consult-gh in an Emacs buffer. 1680 1681 This is a wrapper function around `consult-gh--files-view'. It parses CAND to extract relevant values (e.g. repository, file path, url, ...) and passes them to `consult-gh--files-view'. 1682 1683 To use this as the default action on consult-gh's code candidates, set `consult-gh-code-action' to #'consult-gh--code-view-action." 1684 (let* ((info (cdr cand)) 1685 (repo (plist-get info :repo)) 1686 (branch (or (plist-get info :branch) "HEAD")) 1687 (query (plist-get info :query)) 1688 (code (plist-get info :code)) 1689 (consult-gh-tempdir (expand-file-name (concat (make-temp-name (format "%s/" repo)) "/" branch "/") consult-gh-tempdir)) 1690 (path (plist-get info :path)) 1691 (url (plist-get info :url))) 1692 (consult-gh--files-view repo path url nil nil code) 1693 )) 1694 1695 (defun consult-gh--repo-list-transform (async builder) 1696 "Adds annotation to minibuffer candidates for `consult-gh-repo-list'. 1697 1698 Returns ASYNC function after formatting results with `consult-gh--repo-format'. 1699 BUILDER is the command line builder function (e.g. `consult-gh--repo-list-builder')." 1700 (let (input) 1701 `(lambda (action) 1702 (cond 1703 ((stringp action) 1704 (setq input action) 1705 (funcall ,async action)) 1706 (t (mapcar (lambda (string) 1707 (consult-gh--repo-format string input nil)) 1708 (funcall ,async action))) 1709 )))) 1710 1711 (defun consult-gh--repo-list-builder (input) 1712 "Build gh command line for listing repositories of a GitHub user, INPUT (e.g. `gh repo list INPUT)`. 1713 1714 INPUT must be the name of a GitHub user as a string e.g. \"armindarvish\"." 1715 1716 (pcase-let* ((consult-gh-args (append consult-gh-args '("repo" "list"))) 1717 (cmd (consult--build-args consult-gh-args)) 1718 (`(,arg . ,opts) (consult--command-split input)) 1719 (flags (append cmd opts))) 1720 (unless (or (member "-L" flags) (member "--limit" flags)) 1721 (setq opts (append opts (list "--limit" (format "%s" consult-gh-repo-maxnum))))) 1722 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 1723 (when re 1724 (cons (append cmd 1725 (list (string-join re " ")) 1726 opts) 1727 hl))))) 1728 1729 (defun consult-gh--repo-list (org) 1730 "Lists repos of ORG synchronously. 1731 1732 This runs the command line `gh repo list ORG` to get a list of all repositories belonging to the GitHub user, ORG, and returns the results in a list. Each candidate is formatted by `consult-gh--repo-format'. 1733 1734 ORG must be the name of a github account as a string e.g. \"armindarvish\"." 1735 (let* ((maxnum (format "%s" consult-gh-repo-maxnum)) 1736 (repolist (or (consult-gh--command-to-string "repo" "list" org "--limit" maxnum) "")) 1737 (repos (split-string repolist "\n")) 1738 ) 1739 (mapcar (lambda (src) (consult-gh--repo-format src org nil)) (remove "" repos))) 1740 ) 1741 1742 (defun consult-gh--async-repo-list (prompt builder &optional initial) 1743 "Lists repos of GitHub users/organizations Asynchronously. 1744 1745 This is a non-interactive internal function. For the interactive version see `consult-gh-repo-list'. 1746 1747 It runs the command line from `consult-gh--repo-list-builder' in an async process and returns the results (list of repos of a user) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-gh--repo-list-transform' to add annotation and other info to the candidate. 1748 1749 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 1750 BUILDER is an async builder function passed to `consult--async-command'. 1751 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 1752 " 1753 (let* ((candidates (consult--async-command builder 1754 (consult-gh--repo-list-transform builder) 1755 )) 1756 (current-repo (consult-gh--get-repo-from-directory)) 1757 (initial (or initial 1758 (if (equal consult-gh-prioritize-local-folder 't) (consult-gh--get-username current-repo))))) 1759 (consult--read candidates 1760 :prompt prompt 1761 :lookup (consult-gh--repo-lookup) 1762 :state (funcall #'consult-gh--repo-state) 1763 :initial (consult--async-split-initial initial) 1764 :group #'consult-gh--repo-group 1765 :add-history (append (list 1766 (if current-repo 1767 (consult--async-split-initial (consult-gh--get-username current-repo))) (consult--async-split-thingatpt 'symbol)) 1768 consult-gh--known-orgs-list 1769 ) 1770 :history '(:input consult-gh--orgs-history) 1771 :require-match t 1772 :category 'consult-gh-repos 1773 :preview-key consult-gh-preview-key 1774 :sort nil))) 1775 1776 (defun consult-gh-repo-list (&optional initial noaction) 1777 "Interactive minibuffer query to list repos of GitHub users/organizations Asynchronously. 1778 1779 This is an interactive wrapper function around `consult-gh--async-repo-list'. 1780 1781 It queries the user to enter the name of a GitHub organization/username in the minibuffer, then fetches a list of repositories for the entered username and present them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 1782 1783 Upon selection of a candidate either 1784 - the candidate is returned if NOACTION is non-nil 1785 or 1786 - the candidate is passed to `consult-gh-repo-action' if NOACTION is nil. 1787 1788 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 1789 armindarvish -- -L 100 1790 and the async process will run `gh repo list armindarvish -L 100` which changes the limit for the maximum number of results to fetch to 100. 1791 1792 User selection is tracked in `consult-gh--known-orgs-list' for quick access (added to future history list) in future calls. 1793 1794 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-repo-list'). 1795 1796 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult. 1797 " 1798 (interactive) 1799 (if current-prefix-arg 1800 (setq initial (or initial (format "%s" (car (string-split (car (consult-gh-search-repos initial t)) "/")))))) 1801 (let ((sel (consult-gh--async-repo-list "Enter Org Name: " #'consult-gh--repo-list-builder initial))) 1802 ;;add org and repo to known lists 1803 (when-let ((reponame (plist-get (cdr sel) :repo))) 1804 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 1805 (when-let ((username (plist-get (cdr sel) :user))) 1806 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 1807 (if noaction 1808 sel 1809 (funcall consult-gh-repo-action sel)))) 1810 1811 (defun consult-gh--search-repos-transform (async builder) 1812 "Adds annotation to minibuffer candidates for `consult-gh-search-repos'. 1813 1814 Returns ASYNC function after formatting results with `consult-gh--repo-format'. 1815 BUILDER is the command line builder function (e.g. `consult-gh--search-repos-builder')." 1816 (let (input) 1817 `(lambda (action) 1818 (cond 1819 ((stringp action) 1820 (setq input action) 1821 (funcall ,async action)) 1822 (t (mapcar (lambda (string) 1823 (consult-gh--repo-format string input t)) 1824 (funcall ,async action))) 1825 )))) 1826 1827 (defun consult-gh--search-repos-builder (input) 1828 "Builds gh command line for searching repositories with the query INPUT (e.g. `gh search repos INPUT`)." 1829 1830 (pcase-let* ((consult-gh-args (append consult-gh-args '("search" "repos"))) 1831 (cmd (consult--build-args consult-gh-args)) 1832 (`(,arg . ,opts) (consult--command-split input)) 1833 (flags (append cmd opts))) 1834 (unless (or (member "-L" flags) (member "--limit" flags)) 1835 (setq opts (append opts (list "--limit" (format "%s" consult-gh-repo-maxnum))))) 1836 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 1837 (when re 1838 (cons (append cmd 1839 (list (string-join re " ")) 1840 opts) 1841 hl))))) 1842 1843 (defun consult-gh--async-search-repos (prompt builder &optional initial) 1844 "Interactive minibuffer query to list results of `gh search repos ...` Asynchronously. 1845 1846 This is a non-interactive internal function. For the interactive version see `consult-gh-search-repos'. 1847 1848 It runs the command line from `consult-gh--search-repos-builder' in an async process and returns the results (list of search results for the entry) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-gh--search-repos-transform' to add annotation and other info to the candidate. 1849 1850 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 1851 BUILDER is an async builder function passed to `consult--async-command'. 1852 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 1853 " 1854 (let* ((initial (or initial 1855 (if (equal consult-gh-prioritize-local-folder 't) (consult-gh--get-repo-from-directory) nil)))) 1856 (consult--read 1857 (consult--async-command builder 1858 (consult-gh--search-repos-transform builder) 1859 ) 1860 :prompt prompt 1861 :lookup (consult-gh--repo-lookup) 1862 :state (funcall #'consult-gh--repo-state) 1863 :initial (consult--async-split-initial initial) 1864 :group #'consult-gh--repo-group 1865 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol)) 1866 consult-gh--known-repos-list 1867 ) 1868 :history '(:input consult-gh--search-repos-history) 1869 :require-match t 1870 :category 'consult-gh-repos 1871 :preview-key consult-gh-preview-key 1872 :sort nil))) 1873 1874 (defun consult-gh-search-repos (&optional initial noaction) 1875 "Lists results of `gh search repos` Asynchronously. 1876 1877 This is an interactive wrapper function around `consult-gh--async-search-repos'. It queries the user to enter the name of a GitHub organization/username in the minibuffer, then fetches a list of repositories for the entered username and present them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 1878 1879 Upon selection of a candidate either 1880 - the candidate is returned if NOACTION is non-nil 1881 or 1882 - the candidate is passed to `consult-gh-repo-action' if NOACTION is nil. 1883 1884 Additional commandline arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 1885 consult-gh -- -L 100 1886 and the async process will run `gh search repos -L 100` which changes the limit for the maximum number of results to fetch to 100. 1887 1888 User selection is tracked in `consult-gh--known-orgs-list' for quick access (added to future history list) in future calls. 1889 1890 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-repo-list'). 1891 1892 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult. 1893 " 1894 (interactive) 1895 (let ((sel 1896 (consult-gh--async-search-repos "Search Repos: " #'consult-gh--search-repos-builder initial))) 1897 1898 ;;add org and repo to known lists 1899 (when-let ((reponame (plist-get (cdr sel) :repo))) 1900 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 1901 (when-let ((username (plist-get (cdr sel) :user))) 1902 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 1903 1904 (if noaction 1905 sel 1906 (progn 1907 (funcall consult-gh-repo-action sel) 1908 sel)))) 1909 1910 (defun consult-gh-orgs (&optional orgs noaction) 1911 "List repositories of ORGS. 1912 This is a wrapper function around `consult-gh--repo-list'. If ORGS is nil, this simply calls `consult-gh--repo-list'. If ORGS is a list, then it runs `consult-gh--repo-list' on every member of ORGS and returns the results (repositories of all ORGS) to `consult--read'." 1913 (if (not orgs) 1914 (consult-gh-repo-list nil noaction)) 1915 (let* ((candidates (consult--slow-operation "Collecting Repos ..." (apply #'append (mapcar (lambda (org) (consult-gh--repo-list org)) orgs)))) 1916 (sel (consult--read candidates 1917 :prompt "Select Repo: " 1918 :lookup (consult-gh--repo-lookup) 1919 :state (funcall #'consult-gh--repo-state) 1920 :group #'consult-gh--repo-group 1921 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol)) 1922 consult-gh--known-repos-list 1923 ) 1924 :history 'consult-gh--repos-history 1925 :require-match t 1926 :category 'consult-gh-repos 1927 :preview-key consult-gh-preview-key 1928 :sort t 1929 ))) 1930 (if noaction 1931 sel 1932 (funcall consult-gh-repo-action sel)))) 1933 1934 (defun consult-gh-default-repos () 1935 "List repositories of default orgs (a.k.a. `consult-gh-default-orgs-list'). 1936 1937 This simply passes `consult-gh-default-orgs-list' to `consult-gh-orgs', a useful command for quickly fetching a list of personal GitHub Repositories or any other favorite accounts whose repositories are frequently visited." 1938 (interactive) 1939 (consult-gh-orgs consult-gh-default-orgs-list)) 1940 1941 (defun consult-gh-repo-fork (&optional repos) 1942 "Interactively fork REPOS. 1943 It uses `gh fork repo ...` to fork a repository. 1944 It uses the internal function `consult-gh--repo-fork' which in turn runs `gh fork repo ...`. 1945 If REPOS not supplied, interactively asks user for those values." 1946 (interactive) 1947 (let* ((consult-gh-prioritize-local-folder (if (eq consult-gh-prioritize-local-folder 'suggest) consult-gh-prioritize-local-folder nil)) 1948 (repos (or repos (substring-no-properties (car (consult-gh-search-repos nil t)))))) 1949 (if (stringp repos) 1950 (setq repos (list repos))) 1951 (mapcar (lambda (repo) 1952 (let* ((package (car (last (split-string repo "\/")))) 1953 (name (if consult-gh-confirm-name-before-fork (read-string (concat "name for " (propertize (format "%s: " repo) 'face 'font-lock-keyword-face)) package) package))) 1954 (consult-gh--repo-fork repo name))) repos) 1955 )) 1956 1957 (defun consult-gh-repo-clone (&optional repos targetdir) 1958 "Interactively clone REPOS to TARGETDIR. 1959 It uses the internal function `consult-gh--repo-clone' which in turn runs `gh clone repo ...`. 1960 If REPPOS or TARGETDIR are not supplied, interactively asks user for those values." 1961 (interactive) 1962 (let* ((consult-gh-prioritize-local-folder (if (eq consult-gh-prioritize-local-folder 'suggest) consult-gh-prioritize-local-folder nil)) 1963 (repos (or repos (substring-no-properties (car (consult-gh-search-repos nil t))))) 1964 (targetdir (or targetdir consult-gh-default-clone-directory)) 1965 (clonedir (if consult-gh-confirm-before-clone (read-directory-name "Select Target Directory: " targetdir) (or targetdir default-directory)))) 1966 (if (stringp repos) 1967 (setq repos (list repos))) 1968 (mapcar (lambda (repo) 1969 (let* ((package (consult-gh--get-package repo)) 1970 (name (if consult-gh-confirm-before-clone (read-string (concat "name for " (propertize (format "%s: " repo) 'face 'font-lock-keyword-face)) package) package))) 1971 (consult-gh--repo-clone repo name clonedir)) 1972 ) repos))) 1973 1974 (defun consult-gh--issue-list-transform (async builder) 1975 "Return ASYNC function highlighting grep match results. 1976 BUILDER is the command line builder function." 1977 (let (input) 1978 `(lambda (action) 1979 (cond 1980 ((stringp action) 1981 (setq input action) 1982 (funcall ,async action)) 1983 (t (mapcar (lambda (string) 1984 (consult-gh--issue-list-format string input nil)) 1985 (funcall ,async action))) 1986 )))) 1987 1988 (defun consult-gh--issue-list-builder (input) 1989 "Builds gh command line for listing issues of a GitHub repository, INPUT (e.g. `gh issue list --repo INPUT`). 1990 1991 INPUT must be the full name of a GitHub repository as a string e.g. \"armindarvish\consult-gh\"." 1992 1993 1994 (pcase-let* ((consult-gh-args (append consult-gh-args '("issue" "list" "--repo"))) 1995 (cmd (consult--build-args consult-gh-args)) 1996 (`(,arg . ,opts) (consult--command-split input)) 1997 (flags (append cmd opts))) 1998 (unless (or (member "-L" flags) (member "--limit" flags)) 1999 (setq opts (append opts (list "--limit" (format "%s" consult-gh-issue-maxnum))))) 2000 (unless (or (member "-s" flags) (member "--state" flags)) 2001 (setq opts (append opts (list "--state" (format "%s" consult-gh-issues-state-to-show))))) 2002 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 2003 (when re 2004 (cons (append cmd 2005 (list (string-join re " ")) 2006 opts) 2007 hl))))) 2008 2009 (defun consult-gh--async-issue-list (prompt builder &optional initial) 2010 "Lists issues GitHub repos Asynchronously. 2011 2012 This is a non-interactive internal function. For the interactive version see `consult-gh-issue-list'. 2013 2014 This runs the command line from `consult-gh--repo-list-builder' in an async process and returns the results (list of issues for a repository) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer to change the entry. Each candidate in the minibuffer is formatted by `consult-gh--issue-list-transform' to add annotation and other info to the candidate. 2015 2016 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 2017 BUILDER is an async builder function passed to `consult--async-command'. 2018 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 2019 " 2020 (let* ((initial (or initial 2021 (if (equal consult-gh-prioritize-local-folder 't) (consult-gh--get-repo-from-directory) nil)))) 2022 (consult--read 2023 (consult--async-command builder 2024 (consult-gh--issue-list-transform builder) 2025 ) 2026 :prompt prompt 2027 :lookup (consult-gh--issue-lookup) 2028 :state (funcall #'consult-gh--issue-state) 2029 :initial (consult--async-split-initial initial) 2030 :group #'consult-gh--issue-group-by-state 2031 :require-match t 2032 :category 'consult-gh-issues 2033 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol)) 2034 consult-gh--known-repos-list 2035 ) 2036 :history '(:input consult-gh--repos-history) 2037 :preview-key consult-gh-preview-key 2038 :sort nil))) 2039 2040 (defun consult-gh-issue-list (&optional initial noaction) 2041 "Lists issues of GitHub repository Asynchronously. 2042 With prefix ARG, first search for a repo using `consult-gh-search-repos', then list issues of that selected repo with `consult-gh--async-issue-list'. 2043 2044 This is an interactive wrapper function around `consult-gh--async-issue-list'. 2045 2046 It queries the user to enter the full name of a GitHub repository in the minibuffer (expected format is `OWNER/REPO`), then fetches the list of issues of that repository and present them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 2047 2048 Upon selection of a candidate either 2049 - the candidate is returned if NOACTION is non-nil 2050 or 2051 - the candidate is passed to `consult-gh-issue-action' if NOACTION is nil. 2052 2053 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 2054 armindarvish/consult-gh -- -L 100 2055 and the async process will run `gh issue list --repo armindarvish/consult-gh -L 100` which changes the limit for the maximum number of results to fetch to 100. 2056 2057 User selection is tracked in `consult-gh--known-repos-list' for quick access (added to future history list) in future calls. 2058 2059 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-issue-list'). 2060 2061 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult." 2062 (interactive) 2063 2064 (if current-prefix-arg 2065 (setq initial (or initial (format "%s" (car (consult-gh-search-repos initial t)))))) 2066 2067 (let ((sel (consult-gh--async-issue-list "Enter Repo Name: " #'consult-gh--issue-list-builder initial))) 2068 ;;add org and repo to known lists 2069 (when-let ((reponame (plist-get (cdr sel) :repo))) 2070 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2071 (when-let ((username (plist-get (cdr sel) :user))) 2072 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2073 (if noaction 2074 sel 2075 (funcall consult-gh-issue-action sel)))) 2076 2077 (defun consult-gh--search-issues-transform (async builder) 2078 "Adds annotation to minibuffer candidates for `consult-gh-search-issues'. 2079 2080 Returns ASYNC function after formatting results with `consult-gh--search-issues-format'. 2081 BUILDER is the command line builder function (e.g. `consult-gh--search-issues-builder')." 2082 (let (input) 2083 `(lambda (action) 2084 (cond 2085 ((stringp action) 2086 (setq input action) 2087 (funcall ,async action)) 2088 (t (mapcar (lambda (string) 2089 (consult-gh--search-issues-format string input t)) 2090 (funcall ,async action))) 2091 )))) 2092 2093 (defun consult-gh--search-issues-builder (input) 2094 "Builds gh command line for searching issues with the query INPUT (e.g. `gh search issues INPUT`)." 2095 (pcase-let* ((consult-gh-args (append consult-gh-args '("search" "issues"))) 2096 (cmd (consult--build-args consult-gh-args)) 2097 (`(,arg . ,opts) (consult--command-split input)) 2098 (flags (append cmd opts))) 2099 (unless (or (member "-L" flags) (member "--limit" flags)) 2100 (setq opts (append opts (list "--limit" (format "%s" consult-gh-issue-maxnum))))) 2101 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 2102 (when re 2103 (cons (append cmd 2104 (list (string-join re " ")) 2105 opts) 2106 hl))))) 2107 2108 (defun consult-gh--async-search-issues (prompt builder &optional initial) 2109 "Lists results of `gh search issues ...` Asynchronously. 2110 2111 This is a non-interactive internal function. For the interactive version see `consult-gh-search-issues'. 2112 2113 This runs the command line from `consult-gh--search-issues-builder' in an async process and returns the results (list of search results for the entry) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-gh--search-issues-transform' to add annotation and other info to the candidate. 2114 2115 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 2116 BUILDER is an async builder function passed to `consult--async-command'. 2117 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 2118 " 2119 (consult--read 2120 (consult--async-command builder 2121 (consult-gh--search-issues-transform builder) 2122 ) 2123 :prompt prompt 2124 :lookup (consult-gh--issue-lookup) 2125 :state (funcall #'consult-gh--issue-state) 2126 :initial (consult--async-split-initial initial) 2127 :group #'consult-gh--issue-group-by-repo 2128 :require-match t 2129 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol)) 2130 consult-gh--known-repos-list 2131 ) 2132 :history '(:input consult-gh--search-issues-history) 2133 :category 'consult-gh-issues 2134 :preview-key consult-gh-preview-key 2135 :sort nil)) 2136 2137 (defun consult-gh-search-issues (&optional initial repo noaction) 2138 "Lists results of `gh search issues ...` Asynchronously. 2139 With prefix ARG, first search for a repo using `consult-gh-search-repos', then search issues of only that selected repo. 2140 2141 This is an interactive wrapper function around `consult-gh--async-search-issues'. It queries the user for a search term in the minibuffer, then fetches the list of possible GitHub issue candidates for the entered query and presents them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 2142 2143 Upon selection of a candidate either 2144 - the candidate is returned if NOACTION is non-nil 2145 or 2146 - the candidate is passed to `consult-gh-issue-action' if NOACTION is nil. 2147 2148 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 2149 consult-gh -- -L 100 2150 and the async process will run `gh search issues consult-gh -L 100` which changes the limit for the maximum number of results to fetch to 100. 2151 2152 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-repo-list'). 2153 2154 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult." 2155 (interactive) 2156 (if current-prefix-arg 2157 (setq repo (or repo (substring-no-properties (car (consult-gh-search-repos repo t)))))) 2158 (let* ((consult-gh-args (if repo (append consult-gh-args `("--repo " ,(format "%s" repo))) consult-gh-args)) 2159 (sel (consult-gh--async-search-issues "Search Issues: " #'consult-gh--search-issues-builder initial))) 2160 ;;add org and repo to known lists 2161 (when-let ((reponame (plist-get (cdr sel) :repo))) 2162 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2163 (when-let ((username (plist-get (cdr sel) :user))) 2164 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2165 (if noaction 2166 sel 2167 (funcall consult-gh-issue-action sel) 2168 ))) 2169 2170 (defun consult-gh--pr-list-transform (async builder) 2171 "Return ASYNC function highlighting grep match results. 2172 BUILDER is the command line builder function." 2173 (let (input) 2174 `(lambda (action) 2175 (cond 2176 ((stringp action) 2177 (setq input action) 2178 (funcall ,async action)) 2179 (t (mapcar (lambda (string) 2180 (consult-gh--pr-list-format string input nil)) 2181 (funcall ,async action))) 2182 )))) 2183 2184 (defun consult-gh--pr-list-builder (input) 2185 "Builds gh command line for listing pull requests of a GitHub repository, INPUT (e.g. `gh pr list --repo INPUT`). 2186 2187 INPUT must be the full name of a GitHub repository as a string e.g. \"armindarvish\consult-gh\"." 2188 (pcase-let* ((consult-gh-args (append consult-gh-args '("pr" "list" "--repo"))) 2189 (cmd (consult--build-args consult-gh-args)) 2190 (`(,arg . ,opts) (consult--command-split input)) 2191 (flags (append cmd opts))) 2192 (unless (or (member "-L" flags) (member "--limit" flags)) 2193 (setq opts (append opts (list "--limit" (format "%s" consult-gh-issue-maxnum))))) 2194 (unless (or (member "-s" flags) (member "--state" flags)) 2195 (setq opts (append opts (list "--state" (format "%s" consult-gh-prs-state-to-show))))) 2196 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 2197 (when re 2198 (cons (append cmd 2199 (list (string-join re " ")) 2200 opts) 2201 hl))))) 2202 2203 (defun consult-gh--async-pr-list (prompt builder &optional initial) 2204 "Lists pull requests of GitHub repos Asynchronously. 2205 2206 This is a non-interactive internal function. For the interactive version see `consult-gh-pr-list'. 2207 2208 This runs the command line from `consult-gh--pr-list-builder' in an async process and returns the results (list of issues for a repository) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer to change the entry. Each candidate in the minibuffer is formatted by `consult-gh--pr-list-transform' to add annotation and other relevant info to the candidate. 2209 2210 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 2211 BUILDER is an async builder function passed to `consult--async-command'. 2212 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 2213 " 2214 (let* ((initial (or initial 2215 (if (equal consult-gh-prioritize-local-folder 't) (consult-gh--get-repo-from-directory) nil)))) 2216 (consult--read 2217 (consult--async-command builder 2218 (consult-gh--pr-list-transform builder) 2219 ) 2220 :prompt prompt 2221 :category 'consult-gh-prs 2222 :lookup (consult-gh--pr-lookup) 2223 :state (funcall #'consult-gh--pr-state) 2224 :initial (consult--async-split-initial initial) 2225 :group #'consult-gh--pr-group-by-state 2226 :require-match t 2227 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol)) 2228 consult-gh--known-repos-list 2229 ) 2230 :history '(:input consult-gh--repos-history) 2231 :preview-key consult-gh-preview-key 2232 :sort nil))) 2233 2234 (defun consult-gh-pr-list (&optional initial noaction) 2235 "Lists pull requests of GitHub repository Asynchronously. 2236 With prefix ARG, first search for a repo using `consult-gh-search-repos', then list prs of that selected repo with `consult-gh--async-pr-list'. 2237 2238 This is an interactive wrapper function around `consult-gh--async-pr-list'. 2239 2240 It queries the user to enter the full name of a GitHub repository in the minibuffer (expected format is `OWNER/REPO`), then fetches the list of pull requests for that repository and presents them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 2241 2242 Upon selection of a candidate either 2243 - the candidate is returned if NOACTION is non-nil 2244 or 2245 - the candidate is passed to `consult-gh-pr-action' if NOACTION is nil. 2246 2247 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 2248 armindarvish/consult-gh -- -L 100 2249 and the async process will run `gh pr list --repo armindarvish/consult-gh -L 100` which changes the limit for the maximum number of results to fetch to 100. 2250 2251 User selection is tracked in `consult-gh--known-repos-list' for quick access (added to future history list) in future calls. 2252 2253 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-issue-list'). 2254 2255 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult." 2256 (interactive) 2257 (if current-prefix-arg 2258 (setq initial (or initial (format "%s" (car (consult-gh-search-repos initial t)))))) 2259 2260 (let ((sel (consult-gh--async-pr-list "Enter Repo Name: " #'consult-gh--pr-list-builder initial))) 2261 ;;add org and repo to known lists 2262 (when-let ((reponame (plist-get (cdr sel) :repo))) 2263 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2264 (when-let ((username (plist-get (cdr sel) :user))) 2265 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2266 (if noaction 2267 sel 2268 (funcall consult-gh-pr-action sel)))) 2269 2270 (defun consult-gh--search-prs-transform (async builder) 2271 "Adds annotation to minibuffer candidates for `consult-gh-search-prs'. 2272 2273 Returns ASYNC function after formatting results with `consult-gh--search-prs-format'. 2274 BUILDER is the command line builder function (e.g. `consult-gh--search-prs-builder')." 2275 (let (input) 2276 `(lambda (action) 2277 (cond 2278 ((stringp action) 2279 (setq input action) 2280 (funcall ,async action)) 2281 (t (mapcar (lambda (string) 2282 (consult-gh--search-prs-format string input t)) 2283 (funcall ,async action))) 2284 )))) 2285 2286 (defun consult-gh--search-prs-builder (input) 2287 "Builds gh command line for searching pull requests with the query INPUT (e.g. `gh search prs INPUT`)." 2288 (pcase-let* ((consult-gh-args (append consult-gh-args '("search" "prs"))) 2289 (cmd (consult--build-args consult-gh-args)) 2290 (`(,arg . ,opts) (consult--command-split input)) 2291 (flags (append cmd opts))) 2292 (unless (or (member "-L" flags) (member "--limit" flags)) 2293 (setq opts (append opts (list "--limit" (format "%s" consult-gh-issue-maxnum))))) 2294 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 2295 (when re 2296 (cons (append cmd 2297 (list (string-join re " ")) 2298 opts) 2299 hl))))) 2300 2301 (defun consult-gh--async-search-prs (prompt builder &optional initial) 2302 "Lists results of `gh search prs ...` Asynchronously. 2303 2304 This is a non-interactive internal function. For the interactive version see `consult-gh-search-prs'. 2305 2306 This runs the command line from `consult-gh--search-prs-builder' in an async process and returns the results (list of search results for the entry) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-gh--search-prs-transform' to add annotation and other info to the candidate. 2307 2308 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 2309 BUILDER is an async builder function passed to `consult--async-command'. 2310 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.) 2311 " 2312 (consult--read 2313 (consult--async-command builder 2314 (consult-gh--search-prs-transform builder) 2315 ) 2316 :prompt prompt 2317 :category 'consult-gh-prs 2318 :lookup (consult-gh--pr-lookup) 2319 :state (funcall #'consult-gh--pr-state) 2320 :initial (consult--async-split-initial initial) 2321 :group #'consult-gh--pr-group-by-repo 2322 :require-match t 2323 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol))) 2324 :history '(:input consult-gh--search-prs-history) 2325 :preview-key consult-gh-preview-key 2326 :sort nil)) 2327 2328 (defun consult-gh-search-prs (&optional initial repo noaction) 2329 "Lists results of `gh search prs ...` Asynchronously. 2330 With prefix ARG, first search for a repo using `consult-gh-search-repos', then search prs of only that selected repo. 2331 2332 This is an interactive wrapper function around `consult-gh--async-search-prs'. It queries the user for a search term in the minibuffer, then fetches the list of possible GitHub pr candidates for the entered query and presents them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 2333 2334 Upon selection of a candidate either 2335 - the candidate is returned if NOACTION is non-nil 2336 or 2337 - the candidate is passed to `consult-gh-pr-action' if NOACTION is nil. 2338 2339 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 2340 consult-gh -- -L 100 2341 and the async process will run `gh search prs consult-gh -L 100` which changes the limit for the maximum number of results to fetch to 100. 2342 2343 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-repo-list'). 2344 2345 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult." 2346 (interactive) 2347 (if current-prefix-arg 2348 (setq repo (or repo (substring-no-properties (car (consult-gh-search-repos repo t)))))) 2349 (let* ((consult-gh-args (if repo (append consult-gh-args `("--repo " ,(format "%s" repo))) consult-gh-args)) 2350 (sel (consult-gh--async-search-prs "Search Pull-Requests: " #'consult-gh--search-prs-builder initial))) 2351 ;;add org and repo to known lists 2352 (when-let ((reponame (plist-get (cdr sel) :repo))) 2353 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2354 (when-let ((username (plist-get (cdr sel) :user))) 2355 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2356 (if noaction 2357 sel 2358 (funcall consult-gh-pr-action sel) 2359 ))) 2360 2361 (defun consult-gh--search-code-transform (async builder) 2362 "Adds annotation to minibuffer candidates for `consult-gh-search-code'. 2363 2364 Returns ASYNC function after formatting results with `consult-gh--search-code-format'. 2365 BUILDER is the command line builder function (e.g. `consult-gh--search-code-builder')." 2366 (let (input) 2367 `(lambda (action) 2368 (cond 2369 ((stringp action) 2370 (setq input action) 2371 (funcall ,async action)) 2372 (t (mapcar (lambda (string) 2373 (consult-gh--search-code-format string input t)) 2374 (funcall ,async action))) 2375 )))) 2376 2377 (defun consult-gh--search-code-builder (input) 2378 "Builds gh command line for searching code with the query INPUT (e.g. `gh search code INPUT`)." 2379 2380 (pcase-let* ((consult-gh-args (append consult-gh-args '("search" "code"))) 2381 (cmd (consult--build-args consult-gh-args)) 2382 (`(,arg . ,opts) (consult--command-split input)) 2383 (flags (append cmd opts))) 2384 (unless (or (member "-L" flags) (member "--limit" flags)) 2385 (setq opts (append opts (list "--limit" (format "%s" consult-gh-code-maxnum))))) 2386 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t))) 2387 (when re 2388 (cons (append cmd 2389 (list (string-join re " ")) 2390 opts) 2391 hl))))) 2392 2393 (defun consult-gh--async-search-code (prompt builder &optional initial) 2394 "Lists results of `gh search code ...` Asynchronously. 2395 2396 This is a non-interactive internal function. For the interactive version see `consult-gh-search-code'. 2397 2398 This runs the command line from `consult-gh--search-code-builder' in an async process and returns the results (list of search results for the entry) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-gh--search-code-transform' to add annotation and other info to the candidate. 2399 2400 PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.) 2401 BUILDER is an async builder function passed to `consult--async-command'. 2402 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.)" 2403 (consult--read 2404 (consult--async-command builder 2405 (consult-gh--search-code-transform builder) 2406 ) 2407 :prompt prompt 2408 :category 'consult-gh-codes 2409 :lookup (consult-gh--code-lookup) 2410 :state (funcall #'consult-gh--code-state) 2411 :initial (consult--async-split-initial initial) 2412 :group #'consult-gh--code-group 2413 :require-match t 2414 :add-history (append (list (consult--async-split-initial (consult-gh--get-repo-from-directory)) (consult--async-split-thingatpt 'symbol))) 2415 :history '(:input consult-gh--search-code-history) 2416 :preview-key consult-gh-preview-key 2417 :sort nil)) 2418 2419 (defun consult-gh-search-code (&optional initial repo noaction) 2420 "Lists results of `gh search code ...` Asynchronously. 2421 With prefix ARG, first search for a repo using `consult-gh-search-repos', then search for code only on that selected repo. 2422 2423 This is an interactive wrapper function around `consult-gh--async-search-code'. It queries the user for a search term in the minibuffer, then fetches the list of possible GitHub code candidates for the entered query and presents them as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry. 2424 2425 Upon selection of a candidate either 2426 - the candidate is returned if NOACTION is non-nil 2427 or 2428 - the candidate is passed to `consult-gh-pr-action' if NOACTION is nil. 2429 2430 Additional command line arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments. For example the user can enter the following in the minibuffer: 2431 react -- -L 100 2432 and the async process will run `gh search code react -L 100` which changes the limit for the maximum number of results to fetch to 100. 2433 2434 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-gh--async-search-code'). 2435 2436 For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult." 2437 (interactive) 2438 (if current-prefix-arg 2439 (setq repo (or repo (substring-no-properties (car (consult-gh-search-repos repo t)))))) 2440 (let* ((consult-gh-args (if repo (append consult-gh-args `("--repo " ,(format "%s" repo))) consult-gh-args)) 2441 (sel (consult-gh--async-search-code "Search Code: " #'consult-gh--search-code-builder initial))) 2442 ;;add org and repo to known lists 2443 (when-let ((reponame (plist-get (cdr sel) :repo))) 2444 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2445 (when-let ((username (plist-get (cdr sel) :user))) 2446 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2447 (if noaction 2448 sel 2449 (funcall consult-gh-code-action sel) 2450 ))) 2451 2452 (defun consult-gh-find-file (&optional repo branch initial noaction) 2453 "Interactively find files of a REPO in BRANCH. 2454 2455 Queries the user for name of a REPO (expected format `OWNER/REPO` e.g. armindarvish/consult-gh), then fetches all the branches on that repo and asks the user to select one BRANCH. Then presents the file contents of the REPO and BRANCH for selection. 2456 2457 Upon selection of a candidate either 2458 - the candidate is returned if NOACTION is non-nil 2459 or 2460 - the candidate is passed to `consult-gh-file-action' if NOACTION is nil. 2461 2462 INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-read')" 2463 (interactive) 2464 (let* ((repo (or repo (substring-no-properties (car (consult-gh-search-repos repo t))))) 2465 (branch (or branch (format "%s" (cdr (consult-gh--read-branch repo))))) 2466 (candidates (mapcar #'consult-gh--file-format (consult-gh--files-nodirectory-items repo branch))) 2467 (sel (consult--read candidates 2468 :prompt "Select File: " 2469 :lookup (consult-gh--file-lookup) 2470 :state (funcall #'consult-gh--file-state) 2471 :require-match t 2472 :annotate (lambda (cand) (funcall (consult-gh--file-annotate) candidates cand)) 2473 :history t 2474 :sort nil 2475 :add-history (consult--async-split-thingatpt 'filename) 2476 :history 'consult-gh--files-history 2477 :category 'consult-gh-files 2478 :preview-key consult-gh-preview-key 2479 :initial initial 2480 ))) 2481 2482 ;;add org and repo to known lists 2483 (when-let ((reponame (plist-get (cdr sel) :repo))) 2484 (add-to-history 'consult-gh--known-repos-list (consult--async-split-initial reponame))) 2485 (when-let ((username (plist-get (cdr sel) :user))) 2486 (add-to-history 'consult-gh--known-orgs-list (consult--async-split-initial username))) 2487 2488 (if noaction 2489 sel 2490 (funcall consult-gh-file-action sel) 2491 ) 2492 )) 2493 2494 ;;; provide `consult-gh' module 2495 2496 (provide 'consult-gh) 2497 2498 ;;; consult-gh.el ends here