From 08a84a42c46d223eff4795f69ab4db1acd9f4c29 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 3 Oct 2023 23:34:44 +0200 Subject: [PATCH] forge-{issue,pullreq}-mode: New modes --- lisp/forge-list.el | 2 +- lisp/forge-topic.el | 109 ++++++++++++++++++++++++++------------------ 2 files changed, 66 insertions(+), 45 deletions(-) diff --git a/lisp/forge-list.el b/lisp/forge-list.el index 34a6bd5d..812f90b7 100644 --- a/lisp/forge-list.el +++ b/lisp/forge-list.el @@ -103,7 +103,7 @@ This is a list of package names. Used by the commands "?" #'magit-dispatch) (define-derived-mode forge-topic-list-mode tabulated-list-mode - "Issues" + "Topics" "Major mode for browsing a list of topics." (setq-local x-stretch-cursor nil) (setq tabulated-list-padding 0) diff --git a/lisp/forge-topic.el b/lisp/forge-topic.el index 810ab759..7365ec7a 100644 --- a/lisp/forge-topic.el +++ b/lisp/forge-topic.el @@ -413,7 +413,8 @@ an error. If NOT-THINGATPT is non-nil, then don't use (forge-get-topic (tabulated-list-get-id))) (and demand (user-error "No topic at point")))) -;;; Mode +;;; Topic Modes +;;;; Modes (defvar-keymap forge-post-section-map " " #'forge-edit-post @@ -425,12 +426,29 @@ an error. If NOT-THINGATPT is non-nil, then don't use " " #'markdown-follow-link-at-point "" #'markdown-follow-link-at-point) -(define-derived-mode forge-topic-mode magit-mode "View Topic" - "View a forge issue or pull-request." +(define-derived-mode forge-topic-mode magit-mode "Topic" + "Parent mode of `forge-{issue,pullreq}-mode'. +This mode itself is never used directly." (setq-local markdown-translate-filename-function #'forge--markdown-translate-filename-function)) -(defvar forge-topic-headers-hook +(define-derived-mode forge-issue-mode forge-topic-mode "Issue" + "Mode for looking at a Forge issue.") +(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-issue-headers-hook + '(forge-insert-topic-title + forge-insert-topic-state + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees)) + +(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request" + "Mode for looking at a Forge pull-request.") +(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-pullreq-headers-hook '(forge-insert-topic-title forge-insert-topic-state forge-insert-topic-draft @@ -470,7 +488,9 @@ an error. If NOT-THINGATPT is non-nil, then don't use (magit-set-header-line-format (format "%s: %s" forge-buffer-topic-ident (oref topic title))) (magit-insert-section (topicbuf) - (magit-insert-headers 'forge-topic-headers-hook) + (magit-insert-headers + (intern (format "%s-headers-hook" + (substring (symbol-name major-mode) 0 -5)))) (when (forge-pullreq-p topic) (magit-insert-section (pullreq topic) (magit-insert-heading "Commits") @@ -509,8 +529,8 @@ an error. If NOT-THINGATPT is non-nil, then don't use (cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) forge-buffer-topic-ident) -;;; Headers -;;;; Title +;;;; Sections +;;;;; Title (defvar-keymap forge-topic-title-section-map " " #'forge-edit-topic-title) @@ -520,6 +540,8 @@ an error. If NOT-THINGATPT is non-nil, then don't use (magit-insert-section (topic-title) (insert (format "%-11s" "Title: ") (oref topic title) "\n"))) +;;;;; State + (defvar-keymap forge-topic-state-section-map " " #'forge-edit-topic-state) @@ -537,16 +559,17 @@ an error. If NOT-THINGATPT is non-nil, then don't use ('(open t) 'forge-topic-unmerged) ('(open) 'forge-topic-open)))))))) +;;;;; Draft + (defvar-keymap forge-topic-draft-section-map " " #'forge-edit-topic-draft) (cl-defun forge-insert-topic-draft (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-draft) - (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p)))))) + (magit-insert-section (topic-draft) + (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p))))) -;;;; Milestone +;;;;; Milestone (defvar-keymap forge-topic-milestone-section-map " " #'forge-edit-topic-milestone) @@ -566,7 +589,7 @@ an error. If NOT-THINGATPT is non-nil, then don't use (and-let* ((id (oref topic milestone))) (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) -;;;; Labels +;;;;; Labels (defvar-keymap forge-topic-labels-section-map " " #'forge-edit-topic-labels) @@ -605,7 +628,7 @@ an error. If NOT-THINGATPT is non-nil, then don't use (when description (overlay-put o 'help-echo description)))))) -;;;; Marks +;;;;; Marks (defvar-keymap forge-topic-marks-section-map " " #'forge-edit-topic-marks) @@ -633,28 +656,27 @@ an error. If NOT-THINGATPT is non-nil, then don't use (when description (overlay-put o 'help-echo description))))) -;;;; Refs +;;;;; Refs (cl-defun forge-insert-topic-refs (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-refs) - (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic - (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed)) - (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed))) - (insert (format "%-11s" "Refs: ") - (if cross-repo-p - (concat base-repo separator base-ref) - base-ref) - (propertize "..." 'font-lock-face 'magit-dimmed) - (if cross-repo-p - (if (and head-repo head-ref) - (concat head-repo separator head-ref) - deleted) - (or head-ref deleted)) - "\n")))))) - -;;;; Assignees + (magit-insert-section (topic-refs) + (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic + (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed)) + (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed))) + (insert (format "%-11s" "Refs: ") + (if cross-repo-p + (concat base-repo separator base-ref) + base-ref) + (propertize "..." 'font-lock-face 'magit-dimmed) + (if cross-repo-p + (if (and head-repo head-ref) + (concat head-repo separator head-ref) + deleted) + (or head-ref deleted)) + "\n"))))) + +;;;;; Assignees (defvar-keymap forge-topic-assignees-section-map " " #'forge-edit-topic-assignees) @@ -672,24 +694,23 @@ an error. If NOT-THINGATPT is non-nil, then don't use (insert (propertize "none" 'font-lock-face 'magit-dimmed))) (insert ?\n))) -;;;; Review-Requests +;;;;; Review-Requests (defvar-keymap forge-topic-review-requests-section-map " " #'forge-edit-topic-review-requests) (cl-defun forge-insert-topic-review-requests (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-review-requests) - (insert (format "%-11s" "Review-Requests: ")) - (if-let ((review-requests (closql--iref topic 'review-requests))) - (insert (mapconcat (pcase-lambda (`(,login ,name)) - (format "%s%s (@%s)" - (forge--format-avatar login) - name login)) - review-requests ", ")) - (insert (propertize "none" 'font-lock-face 'magit-dimmed))) - (insert ?\n)))) + (magit-insert-section (topic-review-requests) + (insert (format "%-11s" "Review-Requests: ")) + (if-let ((review-requests (closql--iref topic 'review-requests))) + (insert (mapconcat (pcase-lambda (`(,login ,name)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login)) + review-requests ", ")) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) ;;; Internal Utilities