Skip to content

Commit

Permalink
forge-{issue,pullreq}-mode: New modes
Browse files Browse the repository at this point in the history
  • Loading branch information
@tarsius
tarsius committed Oct 3, 2023
1 parent 248c62d commit 08a84a4
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 45 deletions.
2 changes: 1 addition & 1 deletion lisp/forge-list.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
109 changes: 65 additions & 44 deletions lisp/forge-topic.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-post
Expand All @@ -425,12 +426,29 @@ an error. If NOT-THINGATPT is non-nil, then don't use
"<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
"<mouse-2>" #'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
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-topic-title)
Expand All @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-topic-state)

Expand All @@ -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
"<remap> <magit-edit-thing>" #'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
"<remap> <magit-edit-thing>" #'forge-edit-topic-milestone)
Expand All @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-topic-labels)
Expand Down Expand Up @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-topic-marks)
Expand Down Expand Up @@ -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
"<remap> <magit-edit-thing>" #'forge-edit-topic-assignees)
Expand All @@ -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
"<remap> <magit-edit-thing>" #'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

Expand Down

0 comments on commit 08a84a4

Please sign in to comment.