├── .dir-locals.el
├── .github
    ├── CONTRIBUTING.md
    ├── ISSUE_TEMPLATE
    │   ├── bug_report.md
    │   └── config.yml
    ├── PULL_REQUEST_TEMPLATE
    └── workflows
    │   ├── compile.yml
    │   ├── manual.yml
    │   └── stats.yml
├── .gitignore
├── .mailmap
├── CHANGELOG
├── LICENSE
├── Makefile
├── README.org
├── default.mk
├── docs
    ├── .orgconfig
    ├── Makefile
    ├── forge.org
    ├── forge.texi
    └── htmlxref.cnf
└── lisp
    ├── Makefile
    ├── forge-bitbucket.el
    ├── forge-commands.el
    ├── forge-core.el
    ├── forge-db.el
    ├── forge-discussion.el
    ├── forge-forgejo.el
    ├── forge-gitea.el
    ├── forge-github.el
    ├── forge-gitlab.el
    ├── forge-gogs.el
    ├── forge-issue.el
    ├── forge-notify.el
    ├── forge-post.el
    ├── forge-pullreq.el
    ├── forge-repo.el
    ├── forge-repos.el
    ├── forge-revnote.el
    ├── forge-semi.el
    ├── forge-tablist.el
    ├── forge-topic.el
    ├── forge-topics.el
    └── forge.el


/.dir-locals.el:
--------------------------------------------------------------------------------
 1 | ((nil
 2 |   (indent-tabs-mode . nil))
 3 |  (makefile-mode
 4 |   (indent-tabs-mode . t))
 5 |  (git-commit-mode
 6 |   (git-commit-major-mode . git-commit-elisp-text-mode))
 7 |  (".github/PULL_REQUEST_TEMPLATE"
 8 |   (nil (truncate-lines . nil)))
 9 |  ("CHANGELOG"
10 |   (nil (fill-column . 70)
11 |        (mode . display-fill-column-indicator))))
12 | 


--------------------------------------------------------------------------------
/.github/CONTRIBUTING.md:
--------------------------------------------------------------------------------
 1 | Asking for help
 2 | ===============
 3 | 
 4 | To ask for help please use the **Discussions** feature.  To open
 5 | a new discussion, click [here][new] and then click on <kbd>Select
 6 | Category</kbd>, most likely to select the **Q&A** category.
 7 | 
 8 | Alternatively you can ask for help on the Emacs [StackExchange][se]
 9 | site (using the `forge` tag) or on the Emacs [subreddit].
10 | 
11 | Reporting issues and suggesting features
12 | ========================================
13 | 
14 | To report bugs and suggest new feature use the [issue tracker][issues].
15 | 
16 | Code contributions
17 | ==================
18 | 
19 | If you have some code which you would like to be merged, then open a
20 | [pull request][pulls].  Please create atomic commits with descriptive
21 | commit messages and use a dedicated feature branch (`b s` might help
22 | with the latter).
23 | 
24 | Documentation contributions
25 | ===========================
26 | 
27 | Improving the documentation is always a good way to get started
28 | contributing to some project.
29 | 
30 | In the case of Forge this is somewhat complicated by the fact that
31 | we use some custom extensions.  Some meta documentation can be found
32 | [here][metadocs].
33 | 
34 | TL;DR — Edit `forge.org`.  Do not edit `forge.texi`.  And don't touch
35 | the version numbers.  The maintainers will then update `forge.texi`
36 | and the version numbers in `forge.org` and amend those changes to your
37 | commit.
38 | 
39 | Donations
40 | =========
41 | 
42 | Please also consider to contribute by making a
43 | [monetary donation][donations].
44 | 
45 | 
46 | [discussions]: https://github.com/magit/forge/discussions
47 | [donations]:   https://magit.vc/donate/
48 | [issues]:      https://github.com/magit/forge/issues
49 | [metadocs]:    https://github.com/magit/magit/wiki/Documentation-tools-and-conventions
50 | [new]:         https://github.com/magit/forge/discussions/new
51 | [pulls]:       https://github.com/magit/forge/pulls
52 | [se]:          https://emacs.stackexchange.com
53 | [subreddit]:   https://www.reddit.com/r/emacs
54 | 


--------------------------------------------------------------------------------
/.github/ISSUE_TEMPLATE/bug_report.md:
--------------------------------------------------------------------------------
 1 | ---
 2 | title: 
 3 | name: 🪳 Bug report
 4 | about: Report a defect. Do not use this for support requests and feature suggestions.
 5 | ---
 6 | 
 7 | Please explain
 8 |     (1) what behavior you expected
 9 |     (2) what behavior you observed
10 |     (3) and how we can reproduce the issue.
11 | 
12 | You don't have to quote the above lines to do that.
13 | 
14 | Please include a backtrace in your report.  In most cases doing:
15 | 
16 |     M-x toggle-debug-on-error RET
17 | 
18 | and then going through the steps again should result in a backtrace.
19 | 
20 | Also post the output of:
21 | 
22 |     M-x magit-version RET
23 | 
24 | Before reporting a defect please try to reproduce it using an Emacs instance in which only Magit and its dependencies have been loaded. Other packages or your configuration should not be loaded. This makes it easier to determine whether the issue lays with Magit or something else.
25 | 
26 | ---- now delete this line and everything above ----
27 | 


--------------------------------------------------------------------------------
/.github/ISSUE_TEMPLATE/config.yml:
--------------------------------------------------------------------------------
 1 | blank_issues_enabled: false
 2 | contact_links:
 3 |   - name: "💕 Please support my work on Forge and other Emacs projects"
 4 |     url: https://github.com/sponsors/tarsius
 5 |     about: Thanks! Any support helps. These donations from users are my only income.
 6 |   - name: "💡 Suggest a feature ☛ please open a discussion instead of an issue"
 7 |     url: https://github.com/magit/forge/discussions/categories/ideas
 8 |     about: Start a discussion suggesting an improvement or a new feature.
 9 |   - name: "🆘 Ask the community for support"
10 |     url: https://www.reddit.com/r/emacs
11 |     about: Please also consider supporting others.
12 |   - name: "🆘 Ask the maintainers for support ☛ please open a discussion"
13 |     url: https://github.com/magit/forge/discussions/categories/q-a
14 |     about: Please keep in mind that our bandwidth is limited.
15 |   - name: "ℹ️ Forge FAQ"
16 |     url: https://magit.vc/manual/forge/FAQ.html
17 |     about: Others might have had the same question before.
18 |   - name: "ℹ️ Forge Manual"
19 |     url: https://magit.vc/manual/forge/#Top
20 |     about: The fine manual may also be of use.
21 | 


--------------------------------------------------------------------------------
/.github/PULL_REQUEST_TEMPLATE:
--------------------------------------------------------------------------------
 1 | =================================================================
 2 | Use a dedicated feature branch
 3 | =================================================================
 4 | 
 5 | Please use a dedicated feature branch for your feature request, instead of asking us to merge "your-fork/master" into the "origin/master".  The use of dedicated branches makes it much more convenient to deal with pull-requests, especially when using Magit to do so.
 6 | 
 7 | If you were about to open a pull-request asking us to merge your version of "master", then see [1] for instructions on how to quickly fix that and some information on why we ask you to do so.
 8 | 
 9 | Additionally we ask you to allow us to push to the branch you want us to merge.  We might want to push additional commits and/or make minor changes.  Please make sure the box next to "Allow edits from maintainers" is checked before creating the pull-request.
10 | 
11 |   [1]: https://github.com/magit/magit/wiki/Dedicated-pull-request-branches
12 | 
13 | =================================================================
14 | Do NOT use Github to edit files and create commit messages
15 | =================================================================
16 | 
17 | Unless you are aware of all the pitfalls and take great care to avoid them, the use of Github results in many small defects, including but not limited to trailing whitespace, commit messages containing overlong lines and no newline at the very end, and "GitHub <noreply@github.com>" being used as the committer.  The last one cannot even be avoided, which I consider as an affront.
18 | 
19 | Github is an insufficient interface for editing files and creating commits.  Please don't do it when contributing to Magit.
20 | 
21 | =================================================================
22 | What you should write here
23 | =================================================================
24 | 
25 | Please summarize the changes made in the commits.  Explain why you are making these changes, not just what changes you are making.  This also applies to the commit messages.
26 | 
27 | =================================================================
28 | How to update the manual
29 | =================================================================
30 | 
31 | Edit only "forge.org".  To update "forge.texi" run "make texi".
32 | 


--------------------------------------------------------------------------------
/.github/workflows/compile.yml:
--------------------------------------------------------------------------------
1 | name: Compile
2 | on: [push, pull_request]
3 | jobs:
4 |   compile:
5 |     name: Compile
6 |     uses: emacscollective/workflows/.github/workflows/compile.yml@main
7 | 


--------------------------------------------------------------------------------
/.github/workflows/manual.yml:
--------------------------------------------------------------------------------
 1 | name: Manual
 2 | on:
 3 |   push:
 4 |     branches: main
 5 |     tags: "v[0-9]+.[0-9]+.[0-9]+"
 6 | jobs:
 7 |   manual:
 8 |     name: Manual
 9 |     uses: emacscollective/workflows/.github/workflows/manual.yml@main
10 |     secrets:
11 |       aws-access-key-id: ${{ secrets.AWS_ACCESS_KEY_ID }}
12 |       aws-secret-access-key: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
13 | 


--------------------------------------------------------------------------------
/.github/workflows/stats.yml:
--------------------------------------------------------------------------------
 1 | name: Statistics
 2 | on:
 3 |   push:
 4 |     branches: main
 5 |   schedule:
 6 |     - cron: '3 13 * * 1'
 7 | jobs:
 8 |   stats:
 9 |     name: Statistics
10 |     uses: emacscollective/workflows/.github/workflows/stats.yml@main
11 |     secrets:
12 |       aws-access-key-id: ${{ secrets.AWS_ACCESS_KEY_ID }}
13 |       aws-secret-access-key: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
14 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | /config.mk
 2 | /docs/*.html
 3 | /docs/*.info
 4 | /docs/*.pdf
 5 | /docs/*.texi
 6 | /docs/.revdesc
 7 | /docs/dir
 8 | /docs/stats/
 9 | /lisp/*-autoloads.el
10 | /lisp/*-pkg.el
11 | /lisp/*.elc
12 | 
13 | /docs/forge/
14 | 


--------------------------------------------------------------------------------
/.mailmap:
--------------------------------------------------------------------------------
1 | Paul Bonaud <paul@bonaud.fr> Paul B
2 | Zainab Ali <zainab.ali.london@gmail.com> zainab-ali
3 | 


--------------------------------------------------------------------------------
/CHANGELOG:
--------------------------------------------------------------------------------
  1 | # -*- mode: org -*-
  2 | * v0.5.3    2025-06-04
  3 | 
  4 | - Fixed a regression in v0.5.1, which prevented labeling topics
  5 |   with labels that were created before Github changed the format
  6 |   of label IDs.  #784
  7 | 
  8 | * v0.5.2    2025-06-03
  9 | 
 10 | - Fixed a regression in v0.5.1, which prevented the creation of a
 11 |   pull-request for a branch on a fork.
 12 | 
 13 | * v0.5.1    2025-06-01
 14 | 
 15 | - During topic creation users can now set metadata using a transient
 16 |   menu, instead of having to blindly edit embedded yaml.  Topic
 17 |   creation also saw numerous other improvements, refactorings and
 18 |   fixes.  49c8a78cc et al.
 19 | 
 20 | - ~forge-post-submit-callback-hook~ is now also run when a post is
 21 |   submitted using a GraphQL mutation.  76c9d001e
 22 | 
 23 | - Fixed updating local state after merging a pull-request using the
 24 |   API.  3aee91da1
 25 | 
 26 | - ~forge-pullreq-state-set-merged~ is no longer a no-op and offers to
 27 |   merge using either Git or the API.  64d02997d
 28 | 
 29 | - GraphQL mutations used the ghub token instead of the forge token.
 30 |   #782
 31 | 
 32 | Contains additional code cleanups and fixes.
 33 | 
 34 | * v0.5.0    2025-04-01
 35 | 
 36 | - Added support for Github discussions.  This is a large addition and
 37 |   there are still sharp edges in need of sanding.  3aa6d2a60
 38 | 
 39 | - Added support for more of Github's topic states, i.e., reasons why a
 40 |   topic is closed.  a140b92db
 41 | 
 42 | - Somewhat reluctantly started using GraphQL for mutations.  For those
 43 |   the old REST API was more consistent and pleasant to use, but it does
 44 |   not support newer features.  fe133a75f
 45 | 
 46 | - Added new command ~forge-mark-completed-topics-as-done~.  514d4e31b
 47 | 
 48 | Contains additional code cleanups and fixes.
 49 | 
 50 | * v0.4.8    2025-03-02
 51 | 
 52 | - At least Git 2.25.0 is required now.  Same as for Magit.
 53 | 
 54 | - The type of ~forge--topics-spec~ slot was wrong.  6eac2c3ee
 55 | 
 56 | - Improved bindings added to ~magit-remote~.  de4c964cb
 57 | 
 58 | - Added ~forge-fork~ to ~magit-remote~ menu.  3a2739f35
 59 | 
 60 | - ~forge-remove-topic-locally~ can now remove all marked topics.  #734
 61 | 
 62 | * v0.4.7    2025-02-04
 63 | 
 64 | - Added new hook ~forge-topic-wash-title-hook~.  #735
 65 | 
 66 | - ~forge-rename-default-branch~ now also updates the local symref, which tracks
 67 |   the remote's HEAD.  b7ca5e76f
 68 | 
 69 | - Added new command ~forge-set-default-branch~.  bdbf43f36
 70 | 
 71 | - Added new class ~forge-forgejo-repository~ and changed the ~forge-alist~ for
 72 |   ~codeberg.org~ to use that.  0c81b44fb
 73 | 
 74 | - Added support for visiting blobs using a browser.  #91
 75 | 
 76 | - Added support for creating issues and commenting on existing issues and
 77 |   pull-requests for repositories, that are tracked in Forge's database,
 78 |   but which have not been cloned to the local machine.  #722
 79 | 
 80 | - It is now possible to request a review from a team.  #304
 81 | 
 82 | - Addressed an incompatibility between some legacy behavior in Ghub and
 83 |   ~auth-source-pass~.  You will have to change your configuration for this
 84 |   to be effective.  See the [[https://magit.vc/manual/forge/Setup-for-Gitlabcom.html][updated documentation]].  #720
 85 | 
 86 | - Added new commands ~forge-approve-pullreq~ and ~forge-request-changes~.  #377
 87 | 
 88 | - Started using the ~##~ macro and the ~partial~ shorthand from the ~llama~ package.
 89 |   247330105, b17be58bc
 90 | 
 91 | - Stopped depending on the ~dash~ package.  5c4a1afc8
 92 | 
 93 | - Sorting topics by when they were updated was not possible because the shown
 94 |   key bindings were incorrect, and if if the user figured out what the secret
 95 |   bindings were, then it would have errored.  #745
 96 | 
 97 | - When an unknown label, assignee or review request was encountered, then all
 98 |   entities of that type were ignored.  Now only the unknown entity is ignored.
 99 |   2e040c1d2
100 | 
101 | * v0.4.6    2025-01-01
102 | 
103 | - ~forge-read-topic-labels~ and ~forge-read-topic-marks~ failed to use the
104 |   existing labels/marks as initial input.  #731
105 | 
106 | - The repository at point is now recognized in ~magit-repolist-mode~ buffers.
107 |   bb4d2038f
108 | 
109 | - ~forge-dispatch~ is now bound in ~magit-repolist-mode-map~.  8bace81bc
110 | 
111 | * v0.4.5    2024-12-08
112 | 
113 | - At least Emacs 29.1 is required now.
114 | 
115 | - Started cashing calls to ~git~ during transient menu refreshes, similar
116 |   to how such calls are cached when refreshing a Magit buffer.  #712
117 | 
118 | - Fixed parent keymap of ~forge-issues-mode-map~ and ~forge-pullreqs-mode-map~.
119 |   9ac2afbbb
120 | 
121 | - Fixed a regression in ~forge-topics-setup-buffer~.  #725
122 | 
123 | - By default only draft pull-requests are shown in italic now.  The new
124 |   ~forge-pullreq-draft~ face can be used to control how such pull-requests
125 |   are shown.  Previously all topics that are marked as done were shown
126 |   in italic.  #726
127 | 
128 | - Fixed infinite recursion in ~forge-get-issue~ and ~forge-get-pullreq~.  #704
129 | 
130 | - Fixed visiting commit in a browser.  8f9e94949
131 | 
132 | - Added new variable ~forge-bug-reference-remote-files~.  #703
133 | 
134 | * v0.4.4    2024-10-01
135 | 
136 | Thoughts and whitespace.
137 | 
138 | * v0.4.3    2024-09-04
139 | 
140 | - Fixed tracking a new repository using ~forge-pull~.  a839eaeaa
141 | 
142 | - Fixed type of ~forge--topics-spec~'s ~state~ slot.  5ee14bfbd
143 | 
144 | - Fixed several issues with ~forge--topics-list-command~.  1b4eaaedb, e94f6a37d
145 | 
146 | - When pulling API data outside a Git repository, do not try pull Git data,
147 |   and make sure the buffer is refreshed regardless.  #695
148 | 
149 | * v0.4.2    2024-09-01
150 | 
151 | - Updated tooling.
152 | 
153 | * v0.4.1    2024-08-14
154 | 
155 | - ~forge-add-repository~ now guides the user to set ~forge.remote~ and provides
156 |   pointers to the relevant documentation, when additional configuration is
157 |   required, before a repository can be added to the database.  834c81492 et al.
158 | 
159 | - ~forge-add-repository~ and ~forge-pull~ used to error for repository not hosted
160 |   on a known host or when called outside any Git repository.
161 | 
162 | - Ssh host aliases did not get resolved as intended.  #689
163 | 
164 | - In ~forge-notifications-mode~ buffers ~C-c C-c~ used to error.  7bcdffc75
165 | 
166 | - The "dwim" value displayed for ~forge.remote~ was inaccurate.  6ec5ad186
167 | 
168 | - Added new "Setup a Partially Supported Host" section to manual and fixed
169 |   various typos.  4f6e58b4c
170 | 
171 | - Fixed inaccurate information and typos in the manual and usage messages.
172 |   aa72a4d13 et al.
173 | 
174 | * v0.4.0    2024-08-08
175 | 
176 | This is the biggest Forge release so far, consisting of more than 650 commits
177 | created over the course of more than two years.  I am not able to load all that
178 | into working memory, and many parts of the code have received several rounds of
179 | improvements, so this changelog entry uses broader strokes than usual.
180 | 
181 | - This release pays off a large amount of technical debt.  Many of the changes
182 |   and additions below were only possible thanks to that effort, as are upcoming
183 |   additions.
184 | 
185 | - Which topics are displayed in the current buffer can now be changed, using
186 |   the new prefix command ~forge-topics-menu~, available on ~N m f~.  This command
187 |   is available in any buffer that lists topics, including Magit status buffers.
188 | 
189 |   Previously topic filtering relied on dedicated commands (which listed a
190 |   hard-coded subset in a separate buffer) and functions (which inserted a
191 |   hard-coded subset in a separate section in the status buffer).  Most of
192 |   these commands and functions have been removed.
193 | 
194 |   The default filters can be customized using the new
195 |   ~forge-list-buffer-default-topic-filters~ and
196 |   ~forge-status-buffer-default-topic-filters~ options.  If you really want to
197 |   insert additional hard-coded sets of topics in dedicated sections in the
198 |   status buffer, you can still define them yourself, with the help of the new
199 |   helper function ~forge-insert-topics~.
200 | 
201 | - Dedicated buffers used to list topics now use a major mode derived from
202 |   ~magit-mode~, instead of from ~tabulated-list-mode~.  This makes it possible to
203 |   remove a lot of duplication (because these buffers now use the same code as
204 |   the topic list sections, displayed in the status buffer), and makes adding
205 |   new features more feasible.
206 | 
207 | - ~forge-dispatch~ and the newly added menu commands (such as the already
208 |   mentioned ~transient-topics-menu~) now provide bindings to switch to any of the
209 |   other menus.  Similarly they provide bindings to switch to list buffers.
210 | 
211 |   This should make it easy to discover the new commands, and reduces the need
212 |   to memorize new key bindings.  It is sufficient to remember that ~N~ invokes
213 |   ~forge-dispach~, and to then browse the other menus from there.  That being
214 |   said, more efficient, but harder to remember, bindings are also available,
215 |   such as:
216 | 
217 | - The new prefix command ~forge-topic-menu~, now provides the most convenient way
218 |   to edit an existing topic.  When point is on a topic, it can be invoked using
219 |   ~C-<return>~.  As is always the case in Magit, ~RET~ visits the thing at point in
220 |   a separate buffer.  In the case of topics, ~C-u RET~ does both; it displays the
221 |   buffer and the menu.
222 | 
223 | - The parts of the Github API, that one has to use when syncing the private
224 |   topic status, are truly abysmal.  When I first created Forge, I figured that
225 |   something so fundamentally broken would surely be fixed within a few months,
226 |   and decided to wait until that was done.
227 | 
228 |   I was wrong, five years later nothing has changed, and I had no choice but to
229 |   put in a lot of effort to implement workarounds, to achieve something that is
230 |   worse than what could be trivially achieved, if the API were merely bad.
231 | 
232 |   Most frustratingly the ternary unread/pending/done is represented in API
233 |   responses using a boolean.  That obviously puts limits on the accuracy one
234 |   can achieve in a third-party client.  While that is the worst defect, it is
235 |   just the tip of the iceberg.
236 | 
237 | - All the possible values for the public "state" and the private "status" of
238 |   topics are now supported.
239 | 
240 |   The public state basically answers the question whether a topic has been
241 |   closed yet, and if so, for what reason.  The state can be one of ~open~,
242 |   ~completed~ and ~unplanned~ for issues, and ~open~, ~merged~ and ~rejected~ for
243 |   pull-requests.
244 | 
245 |   The private status answers the questions whether /you/ have seen the latest
246 |   changes yet, that someone else made to it, and when that is the case, whether
247 |   you have additionally decided that you are "done" with that topic.
248 | 
249 |   Due to the defects of the Github API mentioned above, the distinction between
250 |   the ~pending~ and ~done~ statuses of a topic cannot be synchronized with Github.
251 |   So if you use both Forge and the web interface, you will sadly have to perform
252 |   the "mark as done" action twice.
253 | 
254 | - By default Forge now lists "active" topics, i.e., topics whose public state is
255 |   ~open~ and/or whose private status is ~unread~ or ~pending~.  In other words ~active~
256 |   topics are those that likely still require your attention.
257 | 
258 | - At least Emacs 27.1 is required now.  Several dependencies have bumped their
259 |   respective minimal requirement, so I had no choice in the matter, but to be
260 |   honest, I am not unhappy about it.
261 | 
262 | - EmacSQL 4.0.0 is required now, which automatically uses the best available SQL
263 |   backend.  The new backend, which utilizes the built-in support (added in Emacs
264 |   29.1) is preferred.  When using an older Emacs version, or when Emacs unwisely
265 |   was compiled without SQLite support, then a different new backend is used.
266 |   That backend uses the C module provided by the ~sqlite3~ package, which you have
267 |   to install explicitly.  If the module also isn't available, the legacy backend
268 |   is used as a last resort.  That backend is less reliable and much slower than
269 |   the newer alternatives, and is going to be removed from EmacSQL in a not so
270 |   distant future.
271 | 
272 | - It is now possible to add repositories to the local database, without first
273 |   cloning the respective Git repositories, using the same command used to add
274 |   the current Git repository.  That command, ~forge-add-repository~, now also
275 |   offers to fetch only individual topics, or all topics that were modified
276 |   since a cut-off date of the user's choosing, instead of all topics.
277 | 
278 | - A project's topics can now be listed, visited and modified even if no local
279 |   clone of the respective Git repository exists.  One way to navigate to such
280 |   a project's topics is to list all repositories using ~N l r~ and then press
281 |   ~RET~, while point is on the repository in question.
282 | 
283 | - Added new transient menu commands ~forge-topic-menu~, ~forge-topics-menu~,
284 |   ~forge-topic-state-menu~, ~forge-topic-status-menu~, ~forge-repositories-menu~,
285 |   ~forge-configure~, ~forge-post-dispatch~ and ~forge-notifications-menu~, and
286 |   converted ~forge-add-repository~ to a menu command.
287 | 
288 | - Added new commands ~forge-add-some-repository~, ~forge-browse~,
289 |   ~forge-browse-this-repository~, ~forge-browse-this-topic~,
290 |   ~forge-checkout-this-pullreq~, ~forge-forge.graphqlItemLimit~,
291 |   ~forge-issue-state-set-completed~, ~forge-issue-state-set-unplanned~,
292 |   ~forge-list-global-issues~, ~forge-list-global-pullreqs~,
293 |   ~forge-list-global-topics~, ~forge-menu-quit-list~,
294 |   ~forge-notifications-display-all~, ~forge-notifications-display-done~,
295 |   ~forge-notifications-display-inbox~, ~forge-notifications-display-saved~,
296 |   ~forge-notifications-style-flat~, ~forge-notifications-style-nested~,
297 |   ~forge-post-toggle-draft~, ~forge-pull-this-topic~,
298 |   ~forge-pullreq-state-set-merged~, ~forge-pullreq-state-set-rejected~,
299 |   ~forge-read-topic-lift-limit~, ~forge-refresh-buffer~,
300 |   ~forge-rename-default-branch~, ~forge-toggle-topic-legend~,
301 |   ~forge-edit-topic-state~, ~forge-topic-state-set-open~,
302 |   ~forge-topic-status-set-done~, ~forge-topic-status-set-pending~,
303 |   ~forge-topic-status-set-unread~, ~forge-topic-toggle-draft~,
304 |   ~forge-topic-toggle-saved~, ~forge-topics-all-types~, ~forge-topics-filter-active~,
305 |   ~forge-topics-filter-assignee~, ~forge-topics-filter-author~,
306 |   ~forge-topics-filter-issues~, ~forge-topics-filter-labels~,
307 |   ~forge-topics-filter-marks~, ~forge-topics-filter-milestone~,
308 |   ~forge-topics-filter-pullreqs~, ~forge-topics-filter-reviewer~,
309 |   ~forge-topics-filter-saved~, ~forge-topics-filter-state-completed~,
310 |   ~forge-topics-filter-state-open~, ~forge-topics-filter-state-unplanned~,
311 |   ~forge-topics-filter-status-done~, ~forge-topics-filter-status-inbox~,
312 |   ~forge-topics-filter-status-pending~, ~forge-topics-filter-status-unread~,
313 |   ~forge-topics-group~, ~forge-topics-set-limit~, ~forge-topics-set-order~,
314 |   ~forge-topics-ungroup~, ~forge-visit-this-repository~ and ~forge-visit-this-topic~.
315 | 
316 | - Added new options ~forge-buffer-draft-p~, ~forge-limit-topic-choices~,
317 |   ~forge-list-buffer-default-topic-filters~, ~forge-repository-list-columns~,
318 |   ~forge-repository-list-mode-hook~, ~forge-status-buffer-default-topic-filters~
319 |   and ~forge-topic-repository-slug-width~; and remove old options
320 |   ~forge-database-connector~, ~forge-topic-list-mode-hook~, ~forge-topic-list-order~,
321 |   ~forge-topic-list-limit~ and forge-pull-notifications.
322 | 
323 | - Added new faces ~forge-dimmed~, ~forge-issue-completed~, ~forge-issue-open~,
324 |   ~forge-issue-unplanned~, ~forge-pullreq-merged~, ~forge-pullreq-open~,
325 |   ~forge-suffix-active-and-implied~, ~forge-suffix-active~, ~forge-suffix-implied~,
326 |   ~forge-topic-done~, ~forge-topic-header-line~, ~forge-topic-pending~,
327 |   ~forge-topic-slug-completed~, ~forge-topic-slug-open~, ~forge-topic-slug-saved~,
328 |   ~forge-topic-slug-unplanned~, ~forge-topic-slug-unread~ and
329 |   ~forge-pullreq-rejected~.  Some of them are approximate replacements for the
330 |   removed faces ~forge-topic-closed~, ~forge-topic-merged~, ~forge-topic-open~ and
331 |   ~forge-topic-unmerged~.
332 | 
333 | - Added new Git variable ~forge.graphqlItemLimit~.  Ghub now fetches fewer items
334 |   at once by default, but if you repeatedly get ~HTTP Error 502, "Bad gateway"~,
335 |   when pulling API data for some repository, then limiting this to below 50
336 |   is likely to help (but results in more requests and slows down pulling.)
337 | 
338 | - If Forge cannot access its database, it disables itself, to keep Magit usable.
339 | 
340 | - The essential function ~forge-get-repository~ has undergone several rounds of
341 |   improvements and now much better serves the diverse needs of its callers.
342 | 
343 | - When the user has to select a topic using completion, they are initially only
344 |   offered open topics to select from, but by pressing ~+~ the choices can be
345 |   extended to include all topics.
346 | 
347 | Also included are many other new features, improvements and bugfixes.
348 | 
349 | * v0.3.2    2022-03-07
350 | 
351 | - The command ~forge-toggle-display-in-status-buffer~ now affects all
352 |   relevant sections. #470
353 | 
354 | - It is possible to create a pull-request from an existing issue
355 |   again.  #473
356 | 
357 | * v0.3.1    2022-02-16
358 | 
359 | - Added several existing commands to ~forge-dispatch~.
360 | 
361 | - Added new option ~forge-add-default-sections~, which can be set to ~nil~
362 |   to prevent Forge from adding bindings to Magit keymaps and transient
363 |   prefix commands.
364 | 
365 | - Added new command ~forge-browse-repository~.  #443
366 | 
367 | - Added new variable ~forge-format-avatar-function~.  #447
368 | 
369 | - Added support for the ~sqlite-builtin~ and ~sqlite-module~ backends.
370 |   See https://github.com/skeeto/emacsql/pull/86.
371 | 
372 | - Added new option ~forge-checkout-worktree-read-directory-function~.
373 |   #463
374 | 
375 | - Also included are many other improvements, updated documentation and
376 |   bugfixes.
377 | 
378 | * v0.3.0    2021-10-14
379 | 
380 | - Many actions that were surprisingly slow are much faster now,
381 |   because an embarrassing bottleneck was removed in Closql v1.2.0.
382 | 
383 | - Added new option ~forge-database-connector~ allowing the use of other
384 |   database connector libraries beside ~emacsql-sqlite~ (currently only
385 |   ~emacsql-libsqlite3~ (experimental) and ~emacsql-sqlite3~ (discouraged)).
386 |   bae6a527, 21720580
387 | 
388 | - Commands that take a topic or repository as argument now expect an
389 |   object/row ID instead of an object or a number.  Objects are not
390 |   suitable as interactive arguments because their printed
391 |   representation would be presented to the user when using
392 |   ~repeat-complex-command~, and because they might not reflect the
393 |   current state when used like that.  Numbers would be more readable
394 |   and actually meaningful to humans, but additionally they would be
395 |   ambiguous.  Non-interactive functions continue to expect objects
396 |   as arguments.  #368
397 | 
398 | - Some essential key bindings that were somewhat randomly selected
399 |   during initial development have now been changed for consistency,
400 |   which I always intended to do, but did not get around to do until
401 |   now.  ~forge-dispatch~ is now bound to ~N~ instead of ~'~ and Forge's
402 |   bindings in ~magit-fetch~ and ~magit-pull~ now use ~N~ and ~n~ instead of
403 |   ~Y~ and ~y~.  ~N~ was chosen because it was one of the last alphabetic
404 |   keys available at the top-level in Magit.  8c9614e3 et al.
405 | 
406 | - Added new command ~forge-merge~ for merging pull-requests using the
407 |   forge's API, which I recommend you only use if someone forces you
408 |   to do use the API.  3112aded
409 | 
410 | - Added support for following the links that some projects on Github
411 |   display alongside issue templates.  46d5f253
412 | 
413 | - Setting the new Git variable ~forge.autoPull~ to false disables
414 |   pulling Git data whenever API data is fetched.  This may be useful
415 |   in active mono-repos where there is always something new (but likely
416 |   irrelevant) to pull.  #362
417 | 
418 | - Added new commands ~forge-list-labeled-pullreqs~ and
419 |   ~forge-list-labeled-issues~.  a3e6f8aa
420 | 
421 | - Starting with Emacs 28 ~bug-references~ is automatically configure for
422 |   repositories cloned from many Git forges, so Forge no longer has to
423 |   do it.  #283, #412
424 | 
425 | - It is possible to fetch only select topics of a repository, which is
426 |   useful if that happens to be large and/or if you are only interested
427 |   in a select few topics (such as the one you are about to open).
428 |   ~forge-pull~ learned to fetch information about the repository itself
429 |   even when configured to only fetch certain topics.  #382
430 | 
431 | - Added the ~forge-browse-*~ commands to ~forge-dispatch~.  #422
432 | 
433 | - Also included are several other improvements, updated documentation
434 |   and bugfixes.
435 | 
436 | * v0.2.1    2021-06-17
437 | 
438 | - Adjusted to breaking changes in EIEIO in Emacs 28.
439 | 
440 | * v0.2.0    2021-05-25
441 | 
442 | - Second release.
443 | 
444 | - Features and bugfixes.
445 | 
446 | - I haven't been keeping this list updated and don't feel like going
447 |   through hundreds of commits now.  Sorry, maybe next time.
448 | 
449 | * v0.1.0    2018-12-19
450 | 
451 | - Initial beta release.
452 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | -include config.mk
 2 | include default.mk
 3 | 
 4 | .PHONY: lisp docs
 5 | 
 6 | all: lisp docs
 7 | 
 8 | help:
 9 | 	$(info make all          - generate lisp and manual)
10 | 	$(info make lisp         - generate byte-code and autoloads)
11 | 	$(info make redo         - re-generate byte-code and autoloads)
12 | 	$(info make docs         - generate all manual formats)
13 | 	$(info make redo-docs    - re-generate all manual formats)
14 | 	$(info make texi         - generate texi manual)
15 | 	$(info make info         - generate info manual)
16 | 	$(info make html         - generate html manual file)
17 | 	$(info make html-dir     - generate html manual directory)
18 | 	$(info make pdf          - generate pdf manual)
19 | 	$(info make publish      - publish snapshot manuals)
20 | 	$(info make release      - publish release manuals)
21 | 	$(info make stats        - generate statistics)
22 | 	$(info make stats-upload - publish statistics)
23 | 	$(info make clean        - remove most generated files)
24 | 	@printf "\n"
25 | 
26 | lisp:
27 | 	@$(MAKE) -C lisp lisp
28 | redo:
29 | 	@$(MAKE) -C lisp clean lisp
30 | 
31 | docs:
32 | 	@$(MAKE) -C docs docs
33 | redo-docs:
34 | 	@$(MAKE) -C docs redo-docs
35 | texi:
36 | 	@$(MAKE) -C docs texi
37 | info:
38 | 	@$(MAKE) -C docs info
39 | html:
40 | 	@$(MAKE) -C docs html
41 | html-dir:
42 | 	@$(MAKE) -C docs html-dir
43 | pdf:
44 | 	@$(MAKE) -C docs pdf
45 | 
46 | publish:
47 | 	@$(MAKE) -C docs publish
48 | release:
49 | 	@$(MAKE) -C docs release
50 | 
51 | stats:
52 | 	@$(MAKE) -C docs stats
53 | stats-upload:
54 | 	@$(MAKE) -C docs stats-upload
55 | 
56 | clean:
57 | 	@$(MAKE) -C lisp clean
58 | 	@$(MAKE) -C docs clean
59 | 


--------------------------------------------------------------------------------
/README.org:
--------------------------------------------------------------------------------
 1 | ** Work with Git forges from the comfort of Magit
 2 | 
 3 | Work with Git forges, such as Github and Gitlab, from the comfort
 4 | of Magit and the rest of Emacs.
 5 | 
 6 | [[http://readme.emacsair.me/forge-status.png]]
 7 | 
 8 | [[http://readme.emacsair.me/forge-topic.png]]
 9 | 
10 | Please see the [[https://magit.vc/manual/forge][manual]] and the [[https://emacsair.me/2018/12/19/forge-0.1][announcement]] for more information.
11 | 
12 | #+html: <br><br>
13 | #+html: <a href="https://github.com/magit/forge/actions/workflows/compile.yml"><img alt="Compile" src="https://github.com/magit/forge/actions/workflows/compile.yml/badge.svg"/></a>
14 | #+html: <a href="https://github.com/magit/forge/actions/workflows/manual.yml"><img alt="Manual" src="https://github.com/magit/forge/actions/workflows/manual.yml/badge.svg"/></a>
15 | #+html: <a href="https://stable.melpa.org/#/forge"><img alt="MELPA Stable" src="https://stable.melpa.org/packages/forge-badge.svg"/></a>
16 | #+html: <a href="https://melpa.org/#/forge"><img alt="MELPA" src="https://melpa.org/packages/forge-badge.svg"/></a>
17 | 


--------------------------------------------------------------------------------
/default.mk:
--------------------------------------------------------------------------------
 1 | TOP := $(dir $(lastword $(MAKEFILE_LIST)))
 2 | 
 3 | PKG = forge
 4 | 
 5 | ELS  += $(PKG)-db.el
 6 | ELS  += $(PKG)-core.el
 7 | ELS  += $(PKG).el
 8 | ELS  += $(PKG)-repo.el
 9 | ELS  += $(PKG)-post.el
10 | ELS  += $(PKG)-topic.el
11 | ELS  += $(PKG)-discussion.el
12 | ELS  += $(PKG)-issue.el
13 | ELS  += $(PKG)-pullreq.el
14 | ELS  += $(PKG)-revnote.el
15 | ELS  += $(PKG)-notify.el
16 | ELS  += $(PKG)-github.el
17 | ELS  += $(PKG)-gitlab.el
18 | ELS  += $(PKG)-forgejo.el
19 | ELS  += $(PKG)-gitea.el
20 | ELS  += $(PKG)-gogs.el
21 | ELS  += $(PKG)-bitbucket.el
22 | ELS  += $(PKG)-semi.el
23 | ELS  += $(PKG)-commands.el
24 | ELS  += $(PKG)-tablist.el
25 | ELS  += $(PKG)-topics.el
26 | ELS  += $(PKG)-repos.el
27 | ELCS  = $(ELS:.el=.elc)
28 | 
29 | DEPS  = closql
30 | DEPS += compat
31 | DEPS += emacsql
32 | DEPS += ghub/lisp
33 | DEPS += llama
34 | DEPS += magit/lisp
35 | DEPS += markdown-mode
36 | DEPS += seq
37 | DEPS += transient/lisp
38 | DEPS += treepy
39 | DEPS += with-editor/lisp
40 | DEPS += yaml
41 | # Optional
42 | DEPS += sqlite3
43 | DEPS += vertico
44 | 
45 | DOMAIN      ?= magit.vc
46 | CFRONT_DIST ?= E2LUHBKU1FBV02
47 | 
48 | VERSION ?= $(shell test -e $(TOP).git && git describe --tags --abbrev=0 | cut -c2-)
49 | REVDESC := $(shell test -e $(TOP).git && git describe --tags)
50 | 
51 | EMACS      ?= emacs
52 | EMACS_ARGS ?= --eval "(progn \
53 |   (put 'if-let 'byte-obsolete-info nil) \
54 |   (put 'when-let 'byte-obsolete-info nil))"
55 | 
56 | LOAD_PATH  ?= $(addprefix -L ../../,$(DEPS))
57 | LOAD_PATH  += -L .
58 | 
59 | ifndef ORG_LOAD_PATH
60 | ORG_LOAD_PATH += -L ../../org/lisp
61 | endif
62 | 
63 | INSTALL_INFO     ?= $(shell command -v ginstall-info || printf install-info)
64 | MAKEINFO         ?= makeinfo
65 | MANUAL_HTML_ARGS ?= --css-ref /assets/page.css
66 | 
67 | GITSTATS      ?= gitstats
68 | GITSTATS_DIR  ?= $(TOP)docs/stats
69 | GITSTATS_ARGS ?= -c style=https://magit.vc/assets/stats.css -c max_authors=999
70 | 


--------------------------------------------------------------------------------
/docs/.orgconfig:
--------------------------------------------------------------------------------
 1 | # -*- mode:org -*-
 2 | # Copyright (C) 2021-2025 Jonas Bernoulli
 3 | # SPDX-License-Identifier: GPL-3.0-or-later
 4 | # URL: https://github.com/emacscollective/org-macros
 5 | # Visit that to see these macros in a human-readable format.
 6 | 
 7 | #+language: en
 8 | 
 9 | #+options: H:4 num:3 toc:2 compact-itemx:t
10 | #+property: header-args :eval never
11 | 
12 | #+macro: year (eval (format-time-string "%Y"))
13 | #+macro: version (eval (if-let ((tag (ignore-errors (car (process-lines "git" "describe" "--exact-match"))))) (concat "version " (substring tag 1)) (or (ignore-errors (car (process-lines "git" "describe"))) (concat "version " (or $1 "<unknown>")))))
14 | #+macro: kbd (eval (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (let (case-fold-search) (replace-regexp-in-string (regexp-opt '("BS" "TAB" "RET" "ESC" "SPC" "DEL" "LFD" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words) "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
15 | #+macro: kbdvar (eval (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (let (case-fold-search) (replace-regexp-in-string "<\\([a-zA-Z-]+\\)>" "@@texinfo:@var{@@\\1@@texinfo:}@@" (replace-regexp-in-string (regexp-opt '("BS" "TAB" "RET" "ESC" "SPC" "DEL" "LFD" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words) "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t) t))))
16 | #+macro: codevar (eval (format "@@texinfo:@code{@@%s@@texinfo:}@@" (let (case-fold-search) (replace-regexp-in-string "\\([A-Z][A-Z-]+\\)" "@@texinfo:@var{@@\\&@@texinfo:}@@" $1 t))))
17 | #+macro: var @@texinfo:@var{@@$1@@texinfo:}@@
18 | #+macro: dfn @@texinfo:@dfn{@@$1@@texinfo:}@@
19 | 


--------------------------------------------------------------------------------
/docs/Makefile:
--------------------------------------------------------------------------------
  1 | -include ../config.mk
  2 | include ../default.mk
  3 | 
  4 | docs: texi info html html-dir pdf
  5 | 
  6 | texi:     $(PKG).texi
  7 | info:     $(PKG).info dir
  8 | html:     $(PKG).html
  9 | html-dir: $(PKG)/index.html
 10 | pdf:      $(PKG).pdf
 11 | 
 12 | ORG_ARGS  = --batch -Q $(ORG_LOAD_PATH)
 13 | ORG_EVAL += --eval "(setq indent-tabs-mode nil)"
 14 | ORG_EVAL += --eval "(setq org-src-preserve-indentation nil)"
 15 | ORG_EVAL += --eval "\
 16 | (defun org-texinfo--sanitize-content (text)\
 17 |   (replace-regexp-in-string \"[@@{}]\" \"@@\\&\" text))"
 18 | ORG_EVAL += --funcall org-texinfo-export-to-texinfo
 19 | 
 20 | redo-docs:
 21 | 	@touch $(PKG).org
 22 | 	@make docs
 23 | 
 24 | .revdesc: ;
 25 | _    := $(shell test "$(REVDESC)" = "$$(cat .revdesc 2> /dev/null)" ||\
 26 |         echo "$(REVDESC)" > .revdesc)
 27 | 
 28 | %.texi: %.org .orgconfig .revdesc
 29 | 	@printf "Generating $@\n"
 30 | 	@$(EMACS) $(ORG_ARGS) $< $(ORG_EVAL)
 31 | 
 32 | %.info: %.texi
 33 | 	@printf "Generating $@\n"
 34 | 	@$(MAKEINFO) --no-split $< -o $@
 35 | 
 36 | dir: $(PKG).info
 37 | 	@printf "Generating $@\n"
 38 | 	@printf "%s" $^ | xargs -n 1 $(INSTALL_INFO) --dir=$@
 39 | 
 40 | HTML_FIXUP_CSS    = '/<link rel="stylesheet" type="text\/css" href="\/assets\/page.css">/a\
 41 | <link rel="icon" href="/assets/magit_alt1.ico">\
 42 | \n<link class="s-css-s--style" rel="stylesheet"           title="Default"               href="/assets/themes/default.css">\
 43 | \n<link class="s-css-s--style" rel="stylesheet alternate" title="Default high contrast" href="/assets/themes/default-high-contrast.css">\
 44 | \n<link class="s-css-s--style" rel="stylesheet alternate" title="Solarized dark xterm"  href="/assets/themes/solarized-dark-xterm.css">\
 45 | \n<link class="s-css-s--style" rel="stylesheet alternate" title="Black on white"        href="/assets/themes/black-on-white.css">\
 46 | \n<script src="/assets/js/simple-css-switch.js"></script>'
 47 | HTML_FIXUP_ONLOAD = 's/<body lang="en">/<body lang="en" onload="simpleCssSwitch()">/'
 48 | HTML_FIXUP_MENU   = '/<\/body>/i<div id="s-css-s--menu"><\/div>'
 49 | 
 50 | %.html: %.texi
 51 | 	@printf "Generating $@\n"
 52 | 	@$(MAKEINFO) --html --no-split $(MANUAL_HTML_ARGS) $<
 53 | 	@sed -i -e $(HTML_FIXUP_CSS) -e $(HTML_FIXUP_ONLOAD) -e $(HTML_FIXUP_MENU) $@
 54 | 
 55 | %/index.html: %.texi
 56 | 	@printf "Generating $(PKG)/*.html\n"
 57 | 	@rm -rf $(PKG)
 58 | 	@$(MAKEINFO) --html -o $(PKG)/ $(MANUAL_HTML_ARGS) $<
 59 | 	@for f in $$(find $(PKG) -name '*.html') ; do \
 60 | 	sed -i -e $(HTML_FIXUP_CSS) -e $(HTML_FIXUP_ONLOAD) -e $(HTML_FIXUP_MENU) $$f ; \
 61 | 	done
 62 | 
 63 | %.pdf: %.texi
 64 | 	@printf "Generating $@\n"
 65 | 	@texi2pdf --clean $< > /dev/null
 66 | 
 67 | PUBLISH_PATH   ?= /manual/
 68 | RELEASE_PATH   ?= /manual/$(VERSION)/
 69 | S3_BUCKET      ?= s3://$(DOMAIN)
 70 | PUBLISH_TARGET  = $(S3_BUCKET)$(PUBLISH_PATH)
 71 | RELEASE_TARGET  = $(S3_BUCKET)$(RELEASE_PATH)
 72 | CFRONT_PATHS    = $(PKG).html $(PKG).pdf $(PKG)/*
 73 | 
 74 | comma := ,
 75 | empty :=
 76 | space := $(empty) $(empty)
 77 | 
 78 | publish: redo-docs
 79 | 	@aws s3 cp $(PKG).html $(PUBLISH_TARGET)
 80 | 	@aws s3 cp $(PKG).pdf  $(PUBLISH_TARGET)
 81 | 	@aws s3 sync $(PKG)    $(PUBLISH_TARGET)$(PKG)/
 82 | 	@printf "Generating CDN invalidation\n"
 83 | 	@aws cloudfront create-invalidation --distribution-id $(CFRONT_DIST) --paths \
 84 | 	"$(subst $(space),$(comma),$(addprefix $(PUBLISH_PATH),$(CFRONT_PATHS)))" > /dev/null
 85 | 
 86 | release: redo-docs
 87 | 	@aws s3 cp $(PKG).html $(RELEASE_TARGET)
 88 | 	@aws s3 cp $(PKG).pdf  $(RELEASE_TARGET)
 89 | 	@aws s3 sync $(PKG)    $(RELEASE_TARGET)$(PKG)/
 90 | 	@aws s3 cp $(PUBLISH_TARGET)dir.html $(RELEASE_TARGET)dir.html
 91 | 	@aws s3 cp $(PUBLISH_TARGET)dir/index.html $(RELEASE_TARGET)dir/index.html
 92 | 	@printf "Generating CDN invalidation\n"
 93 | 	@aws cloudfront create-invalidation --distribution-id $(CFRONT_DIST) --paths \
 94 | 	"$(subst $(space),$(comma),$(addprefix $(RELEASE_PATH),$(CFRONT_PATHS)))" > /dev/null
 95 | 
 96 | .PHONY: stats
 97 | stats:
 98 | 	@printf "Generating statistics\n"
 99 | 	@$(GITSTATS) $(GITSTATS_ARGS) $(TOP) $(GITSTATS_DIR)
100 | 
101 | stats-upload:
102 | 	@printf "Uploading statistics...\n"
103 | 	@aws s3 sync $(GITSTATS_DIR) $(S3_BUCKET)/stats/$(PKG)
104 | 	@printf "Uploaded to $(S3_BUCKET)/stats/$(PKG)\n"
105 | 	@printf "Generating CDN invalidation\n"
106 | 	@aws cloudfront create-invalidation \
107 | 	--distribution-id $(CFRONT_DIST) --paths "/stats/*" > /dev/null
108 | 
109 | 
110 | CLEAN = $(PKG).info dir $(PKG) $(PKG).html $(PKG).pdf $(GITSTATS_DIR)
111 | 
112 | clean:
113 | 	@printf " Cleaning docs/*...\n"
114 | 	@rm -rf $(CLEAN)
115 | 


--------------------------------------------------------------------------------
/docs/htmlxref.cnf:
--------------------------------------------------------------------------------
 1 | # https://www.gnu.org/software/texinfo/manual/texinfo/html_node/HTML-Xref-Configuration.html
 2 | 
 3 | EMACS = https://www.gnu.org/software/emacs/manual
 4 | 
 5 | auth		mono	${EMACS}/html_mono/auth.html
 6 | auth		node	${EMACS}/html_node/auth/
 7 | 
 8 | ediff		mono	${EMACS}/html_mono/ediff.html
 9 | ediff		node	${EMACS}/html_node/ediff/
10 | 
11 | elisp		mono	${EMACS}/html_mono/elisp.html
12 | elisp		node	${EMACS}/html_node/elisp/
13 | 
14 | emacs		mono	${EMACS}/html_mono/emacs.html
15 | emacs		node	${EMACS}/html_node/emacs/
16 | 
17 | 
18 | MAGIT = https://magit.vc/manual
19 | 
20 | forge		mono	${MAGIT}/forge.html
21 | forge		node	${MAGIT}/forge/
22 | 
23 | ghub		mono	${MAGIT}/ghub.html
24 | ghub		node	${MAGIT}/ghub/
25 | 
26 | magit		mono	${MAGIT}/magit.html
27 | magit		node	${MAGIT}/magit/
28 | 
29 | transient	mono	${MAGIT}/transient.html
30 | transient	node	${MAGIT}/transient/
31 | 
32 | with-editor	mono	${MAGIT}/with-editor.html
33 | with-editor	node	${MAGIT}/with-editor/
34 | 
35 | 
36 | MIRROR = https://emacsmirror.net/manual
37 | 
38 | borg		mono	${MAGIT}/borg.html
39 | borg		node	${MAGIT}/borg/
40 | 
41 | epkg		mono	${MAGIT}/epkg.html
42 | epkg		node	${MAGIT}/epkg/
43 | 


--------------------------------------------------------------------------------
/lisp/Makefile:
--------------------------------------------------------------------------------
 1 | -include ../config.mk
 2 | include ../default.mk
 3 | 
 4 | lisp: $(ELCS) loaddefs check-declare
 5 | 
 6 | loaddefs: $(PKG)-autoloads.el
 7 | 
 8 | $(PKG)-db.elc:
 9 | $(PKG)-core.elc:      $(PKG)-db.elc
10 | $(PKG).elc:           $(PKG)-core.elc
11 | $(PKG)-repo.elc:      $(PKG).elc
12 | $(PKG)-post.elc:      $(PKG).elc
13 | $(PKG)-topic.elc:     $(PKG)-post.elc
14 | $(PKG)-issue.elc:     $(PKG)-topic.elc
15 | $(PKG)-pullreq.elc:   $(PKG)-topic.elc
16 | $(PKG)-revnote.elc:   $(PKG)-topic.elc
17 | $(PKG)-notify.elc:    $(PKG).elc
18 | $(PKG)-github.elc:    $(PKG)-topic.elc $(PKG)-pullreq.elc
19 | $(PKG)-gitlab.elc:    $(PKG)-topic.elc $(PKG)-pullreq.elc
20 | $(PKG)-gitea.elc:     $(PKG).elc
21 | $(PKG)-gogs.elc:      $(PKG).elc
22 | $(PKG)-bitbucket.elc: $(PKG).elc
23 | $(PKG)-semi.elc:      $(PKG).elc
24 | $(PKG)-commands.elc:  $(PKG).elc
25 | $(PKG)-list.elc:      $(PKG).elc
26 | $(PKG)-topics.elc:    $(PKG)-tablist.elc
27 | $(PKG)-repos.elc:     $(PKG)-tablist.elc
28 | 
29 | %.elc: %.el
30 | 	@printf "Compiling $<\n"
31 | 	@$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) -f batch-byte-compile $<
32 | 
33 | check-declare:
34 | 	@printf " Checking function declarations\n"
35 | 	@$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) \
36 | 	--eval "(check-declare-directory default-directory)"
37 | 
38 | CLEAN = $(ELCS) $(PKG)-autoloads.el
39 | 
40 | clean:
41 | 	@printf " Cleaning lisp/*...\n"
42 | 	@rm -rf $(CLEAN)
43 | 
44 | $(PKG)-autoloads.el: $(ELS)
45 | 	@printf " Creating $@\n"
46 | 	@$(EMACS) -Q --batch -l autoload -l cl-lib --eval "\
47 | (let ((file (expand-file-name \"$@\"))\
48 |       (autoload-timestamps nil) \
49 |       (backup-inhibited t)\
50 |       (version-control 'never)\
51 |       (coding-system-for-write 'utf-8-emacs-unix))\
52 |   (write-region (autoload-rubric file \"package\" nil) nil file nil 'silent)\
53 |   (cl-letf (((symbol-function 'progress-reporter-do-update) (lambda (&rest _)))\
54 |             ((symbol-function 'progress-reporter-done) (lambda (_))))\
55 |     (let ((generated-autoload-file file))\
56 |       (update-directory-autoloads default-directory))))" \
57 | 	2>&1 | sed "/^Package autoload is deprecated$$/d"
58 | 


--------------------------------------------------------------------------------
/lisp/forge-bitbucket.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-bitbucket.el --- Bitbucket support  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'buck)
26 | (require 'forge)
27 | 
28 | ;;; Class
29 | 
30 | (defclass forge-bitbucket-repository (forge-noapi-repository)
31 |   ((issues-url-format         :initform "https://%h/%o/%n/issues")
32 |    (issue-url-format          :initform "https://%h/%o/%n/issues/%i")
33 |    ;; The anchor for the issue itself is .../%i#issue-%i
34 |    (issue-post-url-format     :initform "https://%h/%o/%n/issues/%i#comment-%I")
35 |    (pullreqs-url-format       :initform "https://%h/%o/%n/pull-requests")
36 |    (pullreq-url-format        :initform "https://%h/%o/%n/pull-requests/%i")
37 |    (pullreq-post-url-format   :initform "https://%h/%o/%n/pull-requests/%i#comment-%I")
38 |    (commit-url-format         :initform "https://%h/%o/%n/commits/%r")
39 |    (branch-url-format         :initform "https://%h/%o/%n/branch/%r")
40 |    (remote-url-format         :initform "https://%h/%o/%n/src")
41 |    (blob-url-format           :initform "https://%h/%o/%n/src/%r/%f")
42 |    (create-issue-url-format   :initform "https://%h/%o/%n/issues/new")
43 |    (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new")))
44 | 
45 | ;;; _
46 | (provide 'forge-bitbucket)
47 | ;;; forge-bitbucket.el ends here
48 | 


--------------------------------------------------------------------------------
/lisp/forge-core.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-core.el --- Core functionality  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'magit)
 26 | 
 27 | (require 'cl-lib)
 28 | (require 'compat)
 29 | (require 'eieio)
 30 | (require 'llama)
 31 | (require 'seq)
 32 | (require 'subr-x)
 33 | 
 34 | (require 'transient)
 35 | 
 36 | (require 'forge-db)
 37 | 
 38 | (eval-when-compile
 39 |   (cl-pushnew 'forge-id eieio--known-slot-names)
 40 |   (cl-pushnew 'id       eieio--known-slot-names)
 41 |   (cl-pushnew 'name     eieio--known-slot-names)
 42 |   (cl-pushnew 'number   eieio--known-slot-names)
 43 |   (cl-pushnew 'owner    eieio--known-slot-names)
 44 |   (cl-pushnew 'their-id eieio--known-slot-names)
 45 |   (cl-pushnew 'worktree eieio--known-slot-names))
 46 | 
 47 | ;;; Options
 48 | 
 49 | (defgroup forge nil
 50 |   "Options concerning Git forges."
 51 |   :group 'magit)
 52 | 
 53 | (defgroup forge-faces nil
 54 |   "Faces concerning Git forges."
 55 |   :group 'forge
 56 |   :group 'magit-faces)
 57 | 
 58 | (defcustom forge-alist
 59 |   '(;; Forges
 60 |     ("github.com" "api.github.com"
 61 |      "github.com" forge-github-repository)
 62 |     ("ssh.github.com" "api.github.com"
 63 |      "github.com" forge-github-repository)
 64 |     ("gitlab.com" "gitlab.com/api/v4"
 65 |      "gitlab.com" forge-gitlab-repository)
 66 |     ("salsa.debian.org" "salsa.debian.org/api/v4"
 67 |      "salsa.debian.org" forge-gitlab-repository)
 68 |     ("framagit.org" "framagit.org/api/v4"
 69 |      "framagit.org" forge-gitlab-repository)
 70 |     ("gitlab.gnome.org" "gitlab.gnome.org/api/v4"
 71 |      "gitlab.gnome.org" forge-gitlab-repository)
 72 |     ;; Forges (API unsupported)
 73 |     ("codeberg.org" "codeberg.org/api/v1"
 74 |      "codeberg.org" forge-forgejo-repository)
 75 |     ("bitbucket.org" "api.bitbucket.org/2.0"
 76 |      "bitbucket.org" forge-bitbucket-repository)
 77 |     ;; Semi-Forges
 78 |     ("git.savannah.gnu.org" nil
 79 |      "git.savannah.gnu.org" forge-cgit**-repository)
 80 |     ("git.kernel.org" nil
 81 |      "git.kernel.org" forge-cgit-repository)
 82 |     ("repo.or.cz" nil
 83 |      "repo.or.cz" forge-repoorcz-repository)
 84 |     ("git.suckless.org" nil
 85 |      "git.suckless.org" forge-stagit-repository)
 86 |     ("git.sr.ht" nil
 87 |      "git.sr.ht" forge-srht-repository))
 88 |   "List of Git forges.
 89 | 
 90 | Each entry has the form (GITHOST APIHOST WEBHOST CLASS).
 91 | 
 92 | - GITHOST is the host used to access repositories on the forge using
 93 |   Git.
 94 | 
 95 | - APIHOST is the host used to access the forge's API.  For some forges
 96 |   the isn't just a host, but a host followed by the path to the API's
 97 |   endpoint.
 98 | 
 99 | - WEBHOST is the host used to access repositories on this forge using
100 |   a browser.  The IDs used to identify repositories from the forge in
101 |   the local database also derives from this value.
102 | 
103 | - CLASS is the class to be used for repositories from the forge.
104 | 
105 | Complications:
106 | 
107 | - When connecting to a Github Enterprise edition whose REST API's
108 |   end point is \"<host>/v3\" and whose GraphQL API's end point is
109 |   \"<host>/graphql\", then use \"<host>/v3\" as APIHOST.  This is a
110 |   historic accident.  See issue #174.
111 | 
112 | - WEBHOST and CLASS cannot be changed once you have added one or
113 |   more repositories from a forge.  Changing GITHOST and/or APIHOST
114 |   may be possible, but should seldom be necessary."
115 |   :package-version '(forge . "0.4.7")
116 |   :group 'forge
117 |   :type '(repeat (list (string :tag "Git host")
118 |                        (choice (string :tag "API endpoint")
119 |                                (const  :tag "No API" nil))
120 |                        (string :tag "ID")
121 |                        (symbol :tag "Repository class"))))
122 | 
123 | ;;; Class
124 | 
125 | (defclass forge-object (closql-object) () :abstract t)
126 | 
127 | (defmacro forge--childp (obj type)
128 |   "Somewhat similar to `cl-typep' but only for (possibly unknown) classes.
129 | TYPE is evaluated at macro-expansion time but, unlike with
130 | `cl-typep', the respective class does not have to be defined
131 | at that time."
132 |   (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp"))))
133 |     `(and (fboundp ',fn) (,fn ,obj))))
134 | 
135 | ;;; Query
136 | 
137 | (cl-defgeneric forge-get-parent (object)
138 |   "Return the parent object of OBJECT.
139 | The hierarchy is repository > topic > post.
140 | For other objects return nil.")
141 | 
142 | (cl-defgeneric forge-get-repository (demand)
143 |   "Return a forge repository object or nil, or signal an error.
144 | 
145 | A forge repository is a repository hosted on a forge.  The local clone
146 | is also a \"repository\", but it is a \"Git\" repository, not a \"Forge\"
147 | repository.  (Forge repositories are also Git repositories, but not the
148 | other way around.)
149 | 
150 | A `:known' repository has an entry in the local database.  All other
151 | repositories are unknown.  `:known' repositories are divided into two
152 | subgroups: `:tracked' and \"untracked\" repositories.
153 | 
154 | A `:tracked' repository was previously explicitly added to the database
155 | by the user.
156 | 
157 | When Forge encounters a repository, without being instructed by the user
158 | to track it, it may nevertheless add limited information about it to the
159 | database.  Such a repository is `:known' but it is not `:tracked'.
160 | 
161 | Other repositories are \"unknown\".  Most commands can only deal with
162 | repositories that are stored in the database.  Of these, some can deal
163 | with any `:known' repositories, others require that they are `:tracked'.
164 | 
165 | Some other commands exist — such as the browse commands — that have no
166 | such requirement.  While such commands also require a repository object,
167 | they do not care whether that is stored in the database.  Instead they
168 | are happy to use a `:stub' repository; a repository that is not stored
169 | in the database.
170 | 
171 | The DEMAND argument specifies what kind of repository object the caller
172 | requires, at least.  `:tracked' is greater than `:known', which is
173 | greater than `:stub'.  For example, if the caller requests a `:known'
174 | repository, a `:tracked' repository will do, while a `:stub' repository
175 | will not.
176 | 
177 | The valid values for DEMAND are:
178 | 
179 | - `:tracked' and `:tracked?' request a repository that the user added
180 |   to the database.  If there is no such repository, the former causes
181 |   an error to be signaled, while for the latter nil is returned.
182 | 
183 | - `:known?' and `:insert!' request a repository from the database.
184 |   Whether the user explicitly added it does not matter.  If there is no
185 |   such repository, nil is returned for the former, while for the latter
186 |   a new repository is inserted into the repository and then returned.
187 | 
188 | - `:stub' and `:stub?' request the Forge repository corresponding to
189 |   the current Git repository.  It does not matter whether it is known.
190 |   This fails if `default-directory' is not inside a Git repository, if
191 |   there is no matching entry in `forge-alist', or if it is unclear which
192 |   remote to use.  If the repository cannot be determined, the former
193 |   causes an error to be signaled, while for the latter nil is returned.
194 | 
195 |   Stub repository objects are created without making an API request, so
196 |   we lack access to the upstream ID, which the IDs used in out database,
197 |   derive from.  Stub repositories are \"unknown\" in the sense that their
198 |   IDs are not `:known'.  This is done to allow offline operations.
199 | 
200 | - `:valid?' requests the Forge repository corresponding to the current
201 |   Git repository.  It does not matter whether it is known.  If it is
202 |   unknown, an API request is made to verify that the repository exists
203 |   on the forge.  If it does, an object with a valid upstream ID is
204 |   returned, but that isn't inserted into the database.  If not, nil is
205 |   returned.
206 | 
207 | Given a repository object, you can query its `condition' slot to learn
208 | whether it is `:tracked', `:known' (i.e., has a valid ID and is stored
209 | in the database), or merely a `:stub'.
210 | 
211 | You can also use (forge-get repository OBJECT nil DEMAND) to check the
212 | condition of a repository object, or even to ensure a repository object
213 | has a valid upstream ID (using `:valid?'), or that it is tracked in the
214 | database (using `:insert!').
215 | 
216 | Use `forge-repository-equal' to check if two objects refer to the same
217 | repository.
218 | 
219 | Also see info node `(forge) Repository Detection'.")
220 | 
221 | (cl-defgeneric forge-get-topic ()
222 |   "Return a forge issue or pullreq object.")
223 | 
224 | (cl-defgeneric forge-get-issue ()
225 |   "Return a forge issue object.")
226 | 
227 | (cl-defgeneric forge-get-pullreq ()
228 |   "Return a forge pullreq object.")
229 | 
230 | (defun forge--get-forge-host (host &optional demand)
231 |   "Return `forge-alist' entry matching HOST.
232 | 
233 | Entries have the form (GITHOST APIHOST WEBHOST CLASS).
234 | 
235 | - If HOST matches a GITHOST, return the corresponding entry.
236 | - Else, if HOST is an ssh alias and the canonical hostname matches a
237 |   GITHOST, return the corresponding entry.
238 | - Finally, if HOST matches a WEBHOST, return the corresponding entry.
239 | 
240 | If no entry matches, return nil, or signal an error if optional DEMAND
241 | is non-nil."
242 |   (or (assoc host forge-alist)
243 |       (assoc (seq-some (lambda (line)
244 |                          (and (string-prefix-p "hostname" line)
245 |                               (substring line 9)))
246 |                        (ignore-errors
247 |                          (process-lines-ignore-status "ssh" "-G" host)))
248 |              forge-alist)
249 |       (car (cl-member host forge-alist :test #'equal :key #'caddr))
250 |       (and demand
251 |            (error "No entry for \"%s\" in `forge-alist'" host))))
252 | 
253 | (defun forge--split-forge-url (url &optional relax)
254 |   (save-match-data
255 |     (cond
256 |      ((string-match
257 |        (concat "\\`"
258 |                "\\(?:git://\\|"
259 |                "[^/@]+@\\|"
260 |                "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
261 |                "https?://\\(?:[^/@]+@\\)?\\)?"
262 |                (if relax
263 |                    "\\(?1:[^:/]+\\)"
264 |                  (regexp-opt (mapcar #'car forge-alist) t))
265 |                "\\(?::[0-9]+\\)?"
266 |                "\\(?:/\\|:/?\\)"
267 |                "~?\\(?2:.+?\\)/"
268 |                "\\(?3:[^/]+?\\)"
269 |                "\\(?:\\.git\\|/\\)?"
270 |                "\\'")
271 |        url)
272 |       (and-let* ((elt (forge--get-forge-host (match-string 1 url) (not relax))))
273 |         ;; Return the WEBHOST (not the GITHOST, URLs passed to this
274 |         ;; function usually contain a GITHOST) because the IDs used to
275 |         ;; identify a repository in the database are based on WEBHOSTs.
276 |         (list (caddr elt)
277 |               (match-string 2 url)
278 |               (match-string 3 url))))
279 |      ((not relax)
280 |       ;; The host part didn't match any GITHOST in `forge-alist', but it
281 |       ;; might be a ssh host alias.  We have to relax strictness; in the
282 |       ;; extremely unlikely case that there is a common path between the
283 |       ;; HOST and the OWNER for this forge, we would incorrectly end up
284 |       ;; making that path part of the owner.
285 |       (forge--split-forge-url url t)))))
286 | 
287 | ;;; Identity
288 | 
289 | (cl-defgeneric forge--object-id (class &rest args)
290 |   "Return the database id for the CLASS object specified by ARGS.")
291 | 
292 | (cl-defgeneric forge--repository-ids ( class host owner name
293 |                                        &optional stub noerror)
294 |   "Return the database and forge ids for the specified CLASS object.")
295 | 
296 | (defun forge--their-id (id/obj)
297 |   "Return the forge's id for the ID used in the local database."
298 |   (cond
299 |    ((stringp id/obj)
300 |     (car (last (split-string (base64-decode-string id/obj) ":"))))
301 |    ((slot-exists-p id/obj 'their-id)
302 |     (oref id/obj their-id))
303 |    ((slot-exists-p id/obj 'forge-id)
304 |     (oref id/obj forge-id))
305 |    ((forge--their-id (oref id/obj id)))))
306 | 
307 | (cl-defmethod magit-section-ident-value ((obj forge-object))
308 |   "Return the value ob OBJ's `id' slot.
309 | Using OBJ itself would not be appropriate because multiple
310 | non-equal objects may exist, representing the same thing."
311 |   (oref obj id))
312 | 
313 | (defun forge--set-connections (repo object slot list)
314 |   (closql-dset object slot
315 |                (let ((rid (oref repo id)))
316 |                  (mapcar (lambda (value)
317 |                            (forge--object-id
318 |                             rid
319 |                             (if (atom value)
320 |                                 ;; For Gitlab labels we unfortunately only
321 |                                 ;; get a string, the ambiguous name of the
322 |                                 ;; label.  See also the comment in the
323 |                                 ;; Gitlab `forge--update-labels' method.
324 |                                 value
325 |                               (alist-get 'id value))))
326 |                          list))
327 |                t))
328 | 
329 | ;;; Format
330 | 
331 | (cl-defgeneric forge--format (object slot &optional spec)
332 |   "Return a string based on SPEC and the format-string in OBJECT's SLOT.
333 | The available `format'-like specs depend on the type of OBJECT.
334 | SPEC can be used to add additional specs, as for `format-spec'.
335 | The latter override the former.  SLOT is expected to be class-
336 | allocated.  Some methods also accept a format string in place
337 | of SLOT.")
338 | 
339 | (cl-defmethod forge--format-resource ((object forge-object) resource)
340 |   "Return an API resource based on RESOURCE and slots of OBJECT.
341 | For use in `forge--FORGE-METHOD' such as `forge--ghub-get'.
342 | RESOURCE is a string separated by slashes.  Each part that begins
343 | with a colon is replaced with a value from OBJECT.  `:repo' is a
344 | synonym for `:name'.  `:project' is a like `:owner/:name', but the
345 | slash is quoted on Gitlab.  `:topic' is a synonym for `:number'
346 | but only if OBJECT is a topic.  Any other `:SLOT' means to use
347 | the value of that slot in OBJECT, or if that doesn't exist in its
348 | parent object (determined using `forge-get-parent')."
349 |   (save-match-data
350 |     (setq resource
351 |           (replace-regexp-in-string
352 |            ":\\([^/]+\\)"
353 |            (lambda (str)
354 |              (let ((slot (intern (substring str 1))))
355 |                (or (and-let*
356 |                        ((v (ignore-errors
357 |                              (pcase slot
358 |                                ('repo    (oref object name))
359 |                                ('project (concat (string-replace
360 |                                                   "/" "%2F" (oref object owner))
361 |                                                  "%2F"
362 |                                                  (oref object name)))
363 |                                ('topic   (and (forge--childp object 'forge-topic)
364 |                                               (oref object number)))
365 |                                (_        (eieio-oref object slot))))))
366 |                      (format "%s" v))
367 |                    str)))
368 |            resource t t))
369 |     (if (string-match ":[^/]*" resource)
370 |         (if-let ((parent (ignore-errors (forge-get-parent object))))
371 |             (forge--format-resource parent resource)
372 |           (error "Cannot resolve %s for a %s"
373 |                  (match-string 0 resource)
374 |                  (eieio-object-class object)))
375 |       resource)))
376 | 
377 | ;;; Miscellaneous
378 | 
379 | (defun forge-refresh-buffer (&optional buffer)
380 |   "Refresh the current buffer, if it is a Magit or Forge buffer.
381 | Refresh the buffer if its major-mode derives from `magit-mode'
382 | or `forge-repository-list-mode'.  If optional BUFFER is non-nil,
383 | then refresh that buffer, provided it is alive and satisfies
384 | the mode requirement."
385 |   (interactive)
386 |   (cond (buffer
387 |          (when (buffer-live-p buffer)
388 |            (with-current-buffer buffer
389 |              (forge-refresh-buffer))))
390 |         ((derived-mode-p 'forge-topic-mode)
391 |          (magit-refresh-buffer))
392 |         ((derived-mode-p 'magit-mode)
393 |          (magit-refresh-buffer))
394 |         ((and (derived-mode-p 'forge-topic-mode)
395 |               (boundp 'forge--buffer-topics-spec)
396 |               (oref forge--buffer-topics-spec global))
397 |          (revert-buffer))
398 |         ((derived-mode-p 'forge-repository-list-mode)
399 |          (revert-buffer))))
400 | 
401 | (defun forge--sanitize-string (string)
402 |   ;; For Gitlab this may also be nil.
403 |   (if string (string-replace "\r\n" "\n" string) ""))
404 | 
405 | (defun forge--uuid ()
406 |   "Return string with random (version 4) UUID."
407 |   ;; This is a copy of `org-id-uuid'.
408 |   ;; Only used in `forge-create-mark'.
409 |   (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
410 |                           (random)
411 |                           (current-time)
412 |                           (user-uid)
413 |                           (emacs-pid)
414 |                           (user-full-name)
415 |                           user-mail-address
416 |                           (recent-keys)))))
417 |     (format "%s-%s-4%s-%s%s-%s"
418 |             (substring rnd 0 8)
419 |             (substring rnd 8 12)
420 |             (substring rnd 13 16)
421 |             (format "%x"
422 |                     (logior
423 |                      #b10000000
424 |                      (logand
425 |                       #b10111111
426 |                       (string-to-number
427 |                        (substring rnd 16 18) 16))))
428 |             (substring rnd 18 20)
429 |             (substring rnd 20 32))))
430 | 
431 | ;;; _
432 | ;; Local Variables:
433 | ;; read-symbol-shorthands: (
434 | ;;   ("partial" . "llama--left-apply-partially")
435 | ;;   ("rpartial" . "llama--right-apply-partially"))
436 | ;; End:
437 | (provide 'forge-core)
438 | ;;; forge-core.el ends here
439 | 


--------------------------------------------------------------------------------
/lisp/forge-db.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-db.el --- Database implementation  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'closql)
 26 | (require 'compat)
 27 | (require 'eieio)
 28 | (require 'emacsql)
 29 | 
 30 | ;; For `closql--db-update-schema':
 31 | (declare-function forge--object-id "forge-core")
 32 | (declare-function forge-get-issue "forge-core")
 33 | (declare-function forge-get-pullreq "forge-core")
 34 | (declare-function forge-get-repository "forge-core" (demand))
 35 | 
 36 | (eval-when-compile
 37 |   (cl-pushnew 'milestone eieio--known-slot-names)  ; forge-{issue,pullreq}
 38 |   (cl-pushnew 'number    eieio--known-slot-names)) ; forge-{issue,pullreq,...}
 39 | 
 40 | ;;; Options
 41 | 
 42 | (defcustom forge-database-file
 43 |   (expand-file-name "forge-database.sqlite" user-emacs-directory)
 44 |   "The file used to store the forge database."
 45 |   :package-version '(forge . "0.1.0")
 46 |   :group 'forge
 47 |   :type 'file)
 48 | 
 49 | ;;; Core
 50 | 
 51 | (defclass forge-database (closql-database)
 52 |   ((name         :initform "Forge")
 53 |    (object-class :initform 'forge-repository)
 54 |    (file         :initform 'forge-database-file)
 55 |    (schemata     :initform 'forge--db-table-schemata)
 56 |    (version      :initform 15)))
 57 | 
 58 | (defvar forge--override-connection-class nil)
 59 | 
 60 | (defun forge-db (&optional livep)
 61 |   (closql-db 'forge-database livep forge--override-connection-class))
 62 | 
 63 | (defun forge-sql (sql &rest args)
 64 |   (if (stringp sql)
 65 |       (emacsql (forge-db) (apply #'format sql args))
 66 |     (apply #'emacsql (forge-db) sql args)))
 67 | 
 68 | (defun forge-sql-car (sql &rest args)
 69 |   (mapcar #'car (apply #'forge-sql sql args)))
 70 | 
 71 | (defun forge-sql-cdr (sql &rest args)
 72 |   (mapcar #'cdr (apply #'forge-sql sql args)))
 73 | 
 74 | (defun forge-connect-database-once ()
 75 |   "Try to connect Forge database on first use of `magit-status' only."
 76 |   (remove-hook 'magit-status-mode-hook #'forge-connect-database-once)
 77 |   (forge-db))
 78 | (add-hook 'magit-status-mode-hook #'forge-connect-database-once)
 79 | 
 80 | (defun forge-enable-sql-logging ()
 81 |   "Enable logging Forge's SQL queries."
 82 |   (interactive)
 83 |   (let ((conn (oref (forge-db) connection)))
 84 |     (emacsql-enable-debugging conn)
 85 |     (switch-to-buffer-other-window (oref conn log-buffer))))
 86 | 
 87 | ;;; Schemata
 88 | 
 89 | (defconst forge--db-table-schemata
 90 |   '((repository
 91 |      [(class :not-null)
 92 |       (id :not-null :primary-key)
 93 |       forge-id
 94 |       forge
 95 |       owner
 96 |       name
 97 |       apihost
 98 |       githost
 99 |       remote
100 |       condition
101 |       created
102 |       updated
103 |       pushed
104 |       parent
105 |       description
106 |       homepage
107 |       default-branch
108 |       archived-p
109 |       fork-p
110 |       locked-p
111 |       mirror-p
112 |       private-p
113 |       issues-p
114 |       wiki-p
115 |       stars
116 |       watchers
117 |       (assignees :default eieio-unbound)
118 |       (forks     :default eieio-unbound)
119 |       (issues    :default eieio-unbound)
120 |       (labels    :default eieio-unbound)
121 |       (revnotes  :default eieio-unbound)
122 |       (pullreqs  :default eieio-unbound)
123 |       selective-p
124 |       worktree
125 |       (milestones :default eieio-unbound)
126 |       issues-until
127 |       pullreqs-until
128 |       teams
129 |       (discussion-categories :default eieio-unbound)
130 |       (discussions           :default eieio-unbound)
131 |       discussions-p
132 |       discussions-until
133 |       ])
134 | 
135 |     (assignee
136 |      [(repository :not-null)
137 |       (id :not-null :primary-key)
138 |       login
139 |       name
140 |       forge-id]
141 |      (:foreign-key
142 |       [repository] :references repository [id]
143 |       :on-delete :cascade))
144 | 
145 |     (discussion
146 |      [(class :not-null)
147 |       (id :not-null :primary-key)
148 |       repository
149 |       number
150 |       answer
151 |       state
152 |       author
153 |       title
154 |       created
155 |       updated
156 |       closed
157 |       status
158 |       locked-p
159 |       category
160 |       body
161 |       (cards        :default eieio-unbound)
162 |       (edits        :default eieio-unbound)
163 |       (labels       :default eieio-unbound)
164 |       (participants :default eieio-unbound)
165 |       (posts        :default eieio-unbound)
166 |       (reactions    :default eieio-unbound)
167 |       (timeline     :default eieio-unbound)
168 |       (marks        :default eieio-unbound)
169 |       note
170 |       their-id
171 |       slug
172 |       saved-p]
173 |      (:foreign-key
174 |       [repository] :references repository [id]
175 |       :on-delete :cascade))
176 | 
177 |     (discussion-category
178 |      [(repository :not-null)
179 |       (id :not-null :primary-key)
180 |       their-id
181 |       name
182 |       emoji
183 |       answerable-p
184 |       description]
185 |      (:foreign-key
186 |       [repository] :references repository [id]
187 |       :on-delete :cascade))
188 | 
189 |     (discussion-label
190 |      [(discussion :not-null)
191 |       (id :not-null)]
192 |      (:foreign-key
193 |       [discussion] :references discussion [id]
194 |       :on-delete :cascade)
195 |      (:foreign-key
196 |       [id] :references label [id]
197 |       :on-delete :cascade))
198 | 
199 |     (discussion-mark
200 |      [(discussion :not-null)
201 |       (id :not-null)]
202 |      (:foreign-key
203 |       [discussion] :references discussion [id]
204 |       :on-delete :cascade)
205 |      (:foreign-key
206 |       [id] :references mark [id]
207 |       :on-delete :cascade))
208 | 
209 |     (discussion-post ; aka top-level answer
210 |      [(class :not-null)
211 |       (id :not-null :primary-key)
212 |       their-id
213 |       number
214 |       discussion
215 |       author
216 |       created
217 |       updated
218 |       body
219 |       (edits        :default eieio-unbound)
220 |       (reactions    :default eieio-unbound)
221 |       (replies      :default eieio-unbound)]
222 |      (:foreign-key
223 |       [discussion] :references discussion [id]
224 |       :on-delete :cascade))
225 | 
226 |     (discussion-reply ; aka nested reply to top-level answer
227 |      [(class :not-null)
228 |       (id :not-null :primary-key)
229 |       their-id
230 |       number
231 |       post
232 |       discussion
233 |       author
234 |       created
235 |       updated
236 |       body
237 |       (edits        :default eieio-unbound)
238 |       (reactions    :default eieio-unbound)]
239 |      (:foreign-key
240 |       [post] :references discussion-post [id]
241 |       :on-delete :cascade)
242 |      (:foreign-key
243 |       [discussion] :references discussion [id]
244 |       :on-delete :cascade))
245 | 
246 |     (fork
247 |      [(parent :not-null)
248 |       (id :not-null :primary-key)
249 |       owner
250 |       name]
251 |      (:foreign-key
252 |       [parent] :references repository [id]
253 |       :on-delete :cascade))
254 | 
255 |     (issue
256 |      [(class :not-null)
257 |       (id :not-null :primary-key)
258 |       repository
259 |       number
260 |       state
261 |       author
262 |       title
263 |       created
264 |       updated
265 |       closed
266 |       status
267 |       locked-p
268 |       milestone
269 |       body
270 |       (assignees    :default eieio-unbound)
271 |       (cards        :default eieio-unbound)
272 |       (edits        :default eieio-unbound)
273 |       (labels       :default eieio-unbound)
274 |       (participants :default eieio-unbound)
275 |       (posts        :default eieio-unbound)
276 |       (reactions    :default eieio-unbound)
277 |       (timeline     :default eieio-unbound)
278 |       (marks        :default eieio-unbound)
279 |       note
280 |       their-id
281 |       slug
282 |       saved-p]
283 |      (:foreign-key
284 |       [repository] :references repository [id]
285 |       :on-delete :cascade))
286 | 
287 |     (issue-assignee
288 |      [(issue :not-null)
289 |       (id :not-null)]
290 |      (:foreign-key
291 |       [issue] :references issue [id]
292 |       :on-delete :cascade))
293 | 
294 |     (issue-label
295 |      [(issue :not-null)
296 |       (id :not-null)]
297 |      (:foreign-key
298 |       [issue] :references issue [id]
299 |       :on-delete :cascade)
300 |      (:foreign-key
301 |       [id] :references label [id]
302 |       :on-delete :cascade))
303 | 
304 |     (issue-mark
305 |      [(issue :not-null)
306 |       (id :not-null)]
307 |      (:foreign-key
308 |       [issue] :references issue [id]
309 |       :on-delete :cascade)
310 |      (:foreign-key
311 |       [id] :references mark [id]
312 |       :on-delete :cascade))
313 | 
314 |     (issue-post
315 |      [(class :not-null)
316 |       (id :not-null :primary-key)
317 |       issue
318 |       number
319 |       author
320 |       created
321 |       updated
322 |       body
323 |       (edits :default eieio-unbound)
324 |       (reactions :default eieio-unbound)]
325 |      (:foreign-key
326 |       [issue] :references issue [id]
327 |       :on-delete :cascade))
328 | 
329 |     (label
330 |      [(repository :not-null)
331 |       (id :not-null :primary-key)
332 |       name
333 |       color
334 |       description]
335 |      (:foreign-key
336 |       [repository] :references repository [id]
337 |       :on-delete :cascade))
338 | 
339 |     (mark
340 |      [;; For now this is always nil because it seems more useful to
341 |       ;; share marks between repositories.  We cannot omit this slot
342 |       ;; though because `closql--iref' expects `id' to be the second
343 |       ;; slot.
344 |       repository
345 |       (id :not-null :primary-key)
346 |       name
347 |       face
348 |       description])
349 | 
350 |     (milestone
351 |      [(repository :not-null)
352 |       (id :not-null :primary-key)
353 |       number
354 |       title
355 |       created
356 |       updated
357 |       due
358 |       closed
359 |       description]
360 |      (:foreign-key
361 |       [repository] :references repository [id]
362 |       :on-delete :cascade))
363 | 
364 |     (notification
365 |      [(class :not-null)
366 |       (id :not-null :primary-key)
367 |       thread-id
368 |       repository
369 |       type
370 |       topic
371 |       url
372 |       title
373 |       reason
374 |       last-read
375 |       updated]
376 |      (:foreign-key
377 |       [repository] :references repository [id]
378 |       :on-delete :cascade))
379 | 
380 |     (pullreq
381 |      [(class :not-null)
382 |       (id :not-null :primary-key)
383 |       repository
384 |       number
385 |       state
386 |       author
387 |       title
388 |       created
389 |       updated
390 |       closed
391 |       merged
392 |       status
393 |       locked-p
394 |       editable-p
395 |       cross-repo-p
396 |       base-ref
397 |       base-repo
398 |       head-ref
399 |       head-user
400 |       head-repo
401 |       milestone
402 |       body
403 |       (assignees       :default eieio-unbound)
404 |       (cards           :default eieio-unbound)
405 |       (commits         :default eieio-unbound)
406 |       (edits           :default eieio-unbound)
407 |       (labels          :default eieio-unbound)
408 |       (participants    :default eieio-unbound)
409 |       (posts           :default eieio-unbound)
410 |       (reactions       :default eieio-unbound)
411 |       (review-requests :default eieio-unbound)
412 |       (reviews         :default eieio-unbound)
413 |       (timeline        :default eieio-unbound)
414 |       (marks           :default eieio-unbound)
415 |       note
416 |       base-rev
417 |       head-rev
418 |       draft-p
419 |       their-id
420 |       slug
421 |       saved-p]
422 |      (:foreign-key
423 |       [repository] :references repository [id]
424 |       :on-delete :cascade))
425 | 
426 |     (pullreq-assignee
427 |      [(pullreq :not-null)
428 |       (id :not-null)]
429 |      (:foreign-key
430 |       [pullreq] :references pullreq [id]
431 |       :on-delete :cascade))
432 | 
433 |     (pullreq-label
434 |      [(pullreq :not-null)
435 |       (id :not-null)]
436 |      (:foreign-key
437 |       [pullreq] :references pullreq [id]
438 |       :on-delete :cascade)
439 |      (:foreign-key
440 |       [id] :references label [id]
441 |       :on-delete :cascade))
442 | 
443 |     (pullreq-mark
444 |      [(pullreq :not-null)
445 |       (id :not-null)]
446 |      (:foreign-key
447 |       [pullreq] :references pullreq [id]
448 |       :on-delete :cascade)
449 |      (:foreign-key
450 |       [id] :references mark [id]
451 |       :on-delete :cascade))
452 | 
453 |     (pullreq-post
454 |      [(class :not-null)
455 |       (id :not-null :primary-key)
456 |       pullreq
457 |       number
458 |       author
459 |       created
460 |       updated
461 |       body
462 |       (edits :default eieio-unbound)
463 |       (reactions :default eieio-unbound)]
464 |      (:foreign-key
465 |       [pullreq] :references pullreq [id]
466 |       :on-delete :cascade))
467 | 
468 |     (pullreq-review-request
469 |      [(pullreq :not-null)
470 |       (id :not-null)]
471 |      (:foreign-key
472 |       [pullreq] :references pullreq [id]
473 |       :on-delete :cascade))
474 | 
475 |     (revnote
476 |      [(class :not-null)
477 |       (id :not-null :primary-key)
478 |       repository
479 |       commit
480 |       file
481 |       line
482 |       author
483 |       body]
484 |      (:foreign-key
485 |       [repository] :references repository [id]
486 |       :on-delete :cascade))))
487 | 
488 | (cl-defmethod closql--db-update-schema ((db forge-database))
489 |   (let ((version (closql--db-get-version db)))
490 |     (when (< version (oref-default 'forge-database version))
491 |       (forge--backup-database db)
492 |       (closql-with-transaction db
493 |         (forge--db-update-schema db version)))
494 |     (cl-call-next-method)))
495 | 
496 | (defun forge--db-update-schema (db version)
497 |   (cl-macrolet
498 |       ((up (to &rest body)
499 |          `(when (= (1+ version) ,to)
500 |             (message "Upgrading Forge database from version %s to %s..."
501 |                      version ,to)
502 |             ,@body
503 |             (closql--db-set-version db ,to)
504 |             (message "Upgrading Forge database from version %s to %s...done"
505 |                      version ,to)
506 |             (setq version ,to))))
507 |     (up 3
508 |         (emacsql db [:create-table pullreq-review-request $S1]
509 |                  (cdr (assq 'pullreq-review-request forge--db-table-schemata))))
510 |     (up 4
511 |         (emacsql db [:drop-table notification])
512 |         (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
513 |           (when (memq table '(notification
514 |                               mark issue-mark pullreq-mark))
515 |             (emacsql db [:create-table $i1 $S2] table schema)))
516 |         (emacsql db [:alter-table issue   :add-column marks :default $s1] 'eieio-unbound)
517 |         (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound))
518 |     (up 5
519 |         (emacsql db [:alter-table repository :add-column selective-p :default nil]))
520 |     (up 6
521 |         (emacsql db [:alter-table repository :add-column worktree :default nil]))
522 |     (up 7
523 |         (emacsql db [:alter-table issue   :add-column note :default nil])
524 |         (emacsql db [:alter-table pullreq :add-column note :default nil])
525 |         (emacsql db [:create-table milestone $S1]
526 |                  (cdr (assq 'milestone forge--db-table-schemata)))
527 |         (emacsql db [:alter-table repository :add-column milestones :default $s1]
528 |                  'eieio-unbound)
529 |         (pcase-dolist (`(,repo-id ,issue-id ,milestone)
530 |                        (emacsql db [:select [repository id milestone]
531 |                                     :from issue
532 |                                     :where (notnull milestone)]))
533 |           (unless (stringp milestone)
534 |             (oset (forge-get-issue issue-id) milestone
535 |                   (forge--object-id repo-id (cdar milestone)))))
536 |         (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
537 |                        (emacsql db [:select [repository id milestone]
538 |                                     :from pullreq
539 |                                     :where (notnull milestone)]))
540 |           (unless (stringp milestone)
541 |             (oset (forge-get-pullreq pullreq-id) milestone
542 |                   (forge--object-id repo-id (cdar milestone))))))
543 |     (up 8
544 |         (emacsql db [:alter-table pullreq :add-column base-rev :default nil])
545 |         (emacsql db [:alter-table pullreq :add-column head-rev :default nil])
546 |         (emacsql db [:alter-table pullreq :add-column draft-p  :default nil]))
547 |     (up 9
548 |         (emacsql db [:alter-table pullreq :add-column their-id :default nil])
549 |         (emacsql db [:alter-table issue   :add-column their-id :default nil]))
550 |     (up 10
551 |         (emacsql db [:alter-table pullreq :add-column slug :default nil])
552 |         (emacsql db [:alter-table issue   :add-column slug :default nil])
553 |         (pcase-dolist (`(,id ,number ,type)
554 |                        (emacsql
555 |                         db
556 |                         [:select [pullreq:id pullreq:number repository:class]
557 |                          :from pullreq
558 |                          :join repository
559 |                          :on (= pullreq:repository repository:id)]))
560 |           (let ((gitlabp (memq type
561 |                                (append (closql-where-class-in
562 |                                         'forge-gitlab-repository--eieio-childp)
563 |                                        nil))))
564 |             (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)]
565 |                      (format "%s%s" (if gitlabp "!" "#") number)
566 |                      id)))
567 |         (pcase-dolist (`(,id ,number)
568 |                        (emacsql db [:select [id number] :from issue]))
569 |           (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)]
570 |                    (format "#%s" number)
571 |                    id)))
572 |     (up 11
573 |         (emacsql db [:drop-table notification])
574 |         (emacsql db [:create-table notification $S1]
575 |                  (cdr (assq 'notification forge--db-table-schemata)))
576 |         (emacsql db [:alter-table pullreq :rename-column unread-p :to status])
577 |         (emacsql db [:alter-table issue   :rename-column unread-p :to status])
578 |         (emacsql db [:alter-table pullreq :add-column saved-p :default nil])
579 |         (emacsql db [:alter-table issue   :add-column saved-p :default nil]))
580 |     (up 12
581 |         (emacsql db [:drop-table notification])
582 |         (emacsql db [:create-table notification $S1]
583 |                  (cdr (assq 'notification forge--db-table-schemata)))
584 |         (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)]))
585 |           (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)]
586 |                    id))
587 |         (dolist (id (emacsql db [:select id :from issue :where (isnull status)]))
588 |           (emacsql db [:update issue :set (= state 'done) :where (= id $s1)]
589 |                    id))
590 |         (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)]))
591 |           (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)]
592 |                    id))
593 |         (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)]))
594 |           (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)]
595 |                    id))
596 |         (emacsql db [:alter-table repository :add-column issues-until :default nil])
597 |         (emacsql db [:alter-table repository :add-column pullreqs-until :default nil]))
598 |     (up 13
599 |         (dolist (id (emacsql db [:select id :from repository
600 |                                  :where (isnull issues-until)]))
601 |           (emacsql
602 |            db [:update repository :set (= issues-until $s1) :where (= id $s2)]
603 |            (caar (forge-sql [:select [updated] :from issue
604 |                              :where (= repository $s1)
605 |                              :order-by [(desc updated)]
606 |                              :limit 1]
607 |                             id))
608 |            id))
609 |         (dolist (id (emacsql db [:select id :from repository
610 |                                  :where (isnull pullreqs-until)]))
611 |           (emacsql
612 |            db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)]
613 |            (caar (forge-sql [:select [updated] :from pullreq
614 |                              :where (= repository $s1)
615 |                              :order-by [(desc updated)]
616 |                              :limit 1]
617 |                             id))
618 |            id))
619 |         (emacsql db [:alter-table repository :rename-column sparse-p :to condition])
620 |         (pcase-dolist (`(,id ,not-tracked)
621 |                        (emacsql db [:select [id condition] :from repository]))
622 |           (emacsql
623 |            db [:update repository :set (= condition $s1) :where (= id $s2)]
624 |            (if not-tracked :known :tracked)
625 |            id)))
626 |     (up 14
627 |         (emacsql db [:alter-table repository :add-column teams :default nil]))
628 |     (up 15
629 |         (emacsql db [:create-table discussion $S1]
630 |                  (cdr (assq 'discussion forge--db-table-schemata)))
631 |         (emacsql db [:create-table discussion-category $S1]
632 |                  (cdr (assq 'discussion-category forge--db-table-schemata)))
633 |         (emacsql db [:create-table discussion-label $S1]
634 |                  (cdr (assq 'discussion-label forge--db-table-schemata)))
635 |         (emacsql db [:create-table discussion-mark $S1]
636 |                  (cdr (assq 'discussion-mark forge--db-table-schemata)))
637 |         (emacsql db [:create-table discussion-post $S1]
638 |                  (cdr (assq 'discussion-post forge--db-table-schemata)))
639 |         (emacsql db [:create-table discussion-reply $S1]
640 |                  (cdr (assq 'discussion-reply forge--db-table-schemata))))
641 |         (emacsql db [:alter-table repository :add-column discussion-categories
642 |                      :default 'eieio-unbound])
643 |         (emacsql db [:alter-table repository :add-column discussions
644 |                      :default 'eieio-unbound])
645 |         (emacsql db [:alter-table repository :add-column discussions-p
646 |                      :default nil])
647 |         (emacsql db [:alter-table repository :add-column discussions-until
648 |                      :default nil])
649 |     ))
650 | 
651 | (defun forge--backup-database (db)
652 |   (let ((dst (concat (file-name-sans-extension forge-database-file)
653 |                      (format "-v%s" (caar (emacsql (oref db connection)
654 |                                                    [:pragma user-version])))
655 |                      (format-time-string "-%Y%m%d-%H%M")
656 |                      ".sqlite")))
657 |     (message "Copying Forge database to %s..." dst)
658 |     (copy-file forge-database-file dst)
659 |     (message "Copying Forge database to %s...done" dst)))
660 | 
661 | ;;; _
662 | ;; Local Variables:
663 | ;; read-symbol-shorthands: (
664 | ;;   ("partial" . "llama--left-apply-partially")
665 | ;;   ("rpartial" . "llama--right-apply-partially"))
666 | ;; End:
667 | (provide 'forge-db)
668 | ;;; forge-db.el ends here
669 | 


--------------------------------------------------------------------------------
/lisp/forge-discussion.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-discussion.el --- Discussion support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <jonas@bernoul.li>
  6 | ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'forge)
 26 | (require 'forge-post)
 27 | (require 'forge-topic)
 28 | 
 29 | ;;; Classes
 30 | 
 31 | (defclass forge-discussion (forge-topic)
 32 |   ((closql-table         :initform 'discussion)
 33 |    (closql-primary-key   :initform 'id)
 34 |    (closql-order-by      :initform [(desc number)])
 35 |    (closql-foreign-key   :initform 'repository)
 36 |    (closql-class-prefix  :initform "forge-")
 37 |    (id                   :initarg :id)
 38 |    (repository           :initarg :repository)
 39 |    (number               :initarg :number)
 40 |    (answer               :initarg :answer)
 41 |    (state                :initarg :state)
 42 |    (author               :initarg :author)
 43 |    (title                :initarg :title)
 44 |    (created              :initarg :created)
 45 |    (updated              :initarg :updated)
 46 |    (closed               :initarg :closed)
 47 |    (status               :initarg :status :initform nil)
 48 |    (locked-p             :initarg :locked-p :initform nil)
 49 |    (category             :initarg :category)
 50 |    (body                 :initarg :body)
 51 |    (project-cards) ; projectsCards
 52 |    (edits) ; userContentEdits
 53 |    (labels               :closql-tables (discussion-label label))
 54 |    (participants)
 55 |    (posts                :closql-class forge-discussion-post)
 56 |    (reactions)
 57 |    (timeline)
 58 |    (marks                :closql-tables (discussion-mark mark))
 59 |    (note                 :initarg :note     :initform nil)
 60 |    (their-id             :initarg :their-id)
 61 |    (slug                 :initarg :slug)
 62 |    (saved-p              :initarg :saved-p :initform nil)
 63 |    ))
 64 | 
 65 | (defclass forge-discussion-post (forge-post)
 66 |   ((closql-table         :initform 'discussion-post)
 67 |    (closql-primary-key   :initform 'id)
 68 |    (closql-order-by      :initform [(asc number)])
 69 |    (closql-foreign-key   :initform 'discussion)
 70 |    (closql-class-prefix  :initform "forge-discussion-")
 71 |    (id                   :initarg :id)
 72 |    (their-id             :initarg :their-id)
 73 |    (number               :initarg :number)
 74 |    (discussion           :initarg :discussion)
 75 |    (author               :initarg :author)
 76 |    (created              :initarg :created)
 77 |    (updated              :initarg :updated)
 78 |    (body                 :initarg :body)
 79 |    (edits)
 80 |    (reactions)
 81 |    (replies              :closql-class forge-discussion-reply)
 82 |    ))
 83 | 
 84 | (defclass forge-discussion-reply (forge-post)
 85 |   ((closql-table         :initform 'discussion-reply)
 86 |    (closql-primary-key   :initform 'id)
 87 |    (closql-order-by      :initform [(asc number)])
 88 |    (closql-foreign-key   :initform 'post)
 89 |    (closql-class-prefix  :initform "forge-discussion-")
 90 |    (id                   :initarg :id)
 91 |    (their-id             :initarg :their-id)
 92 |    (number               :initarg :number)
 93 |    (post                 :initarg :post)
 94 |    (discussion           :initarg :discussion)
 95 |    (author               :initarg :author)
 96 |    (created              :initarg :created)
 97 |    (updated              :initarg :updated)
 98 |    (body                 :initarg :body)
 99 |    (edits)
100 |    (reactions)
101 |    ))
102 | 
103 | ;;; Query
104 | ;;;; Get
105 | 
106 | (cl-defmethod forge-get-repository ((post forge-discussion-post))
107 |   (forge-get-repository (forge-get-discussion post)))
108 | 
109 | (cl-defmethod forge-get-topic ((post forge-discussion-post))
110 |   (forge-get-discussion post))
111 | 
112 | (cl-defmethod forge-get-discussion ((disc forge-discussion))
113 |   disc)
114 | 
115 | (cl-defmethod forge-get-discussion ((repo forge-repository) number)
116 |   (closql-get (forge-db)
117 |               (forge--object-id 'forge-discussion repo number)
118 |               'forge-discussion))
119 | 
120 | (cl-defmethod forge-get-discussion ((number integer))
121 |   (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
122 |     (forge-get-discussion repo number)))
123 | 
124 | (cl-defmethod forge-get-discussion ((id string))
125 |   (closql-get (forge-db) id 'forge-discussion))
126 | 
127 | (cl-defmethod forge-get-discussion ((post forge-discussion-post))
128 |   (closql-get (forge-db)
129 |               (oref post discussion)
130 |               'forge-discussion))
131 | 
132 | ;; (cl-defmethod forge-get-discussion ((post forge-discussion-reply))
133 | ;;   (closql-get (forge-db)
134 | ;;               (oref post discussion)
135 | ;;               'forge-discussion))
136 | 
137 | ;; (cl-defmethod forge-get-discussion-post ((reply forge-discussion-reply))
138 | ;;   (closql-get (forge-db)
139 | ;;               (oref reply post)
140 | ;;               'forge-discussion-post))
141 | 
142 | ;;;; Current
143 | 
144 | (defun forge-current-chatter (&optional demand)
145 |   "Return the discussion or issue at point or being visited.
146 | If there is no such discussion or issue and DEMAND is non-nil, then
147 | signal an error."
148 |   (or (forge-discussion-at-point)
149 |       (forge-issue-at-point)
150 |       (and (or (forge-discussion-p forge-buffer-topic)
151 |                (forge-issue-p forge-buffer-topic))
152 |            forge-buffer-topic)
153 |       (and demand (user-error "No current discussion or issue"))))
154 | 
155 | (defun forge-current-discussion (&optional demand)
156 |   "Return the discussion at point or being visited.
157 | If there is no such discussion and DEMAND is non-nil, then signal
158 | an error."
159 |   (or (forge-discussion-at-point)
160 |       (and (forge-discussion-p forge-buffer-topic)
161 |            forge-buffer-topic)
162 |       (and demand (user-error "No current discussion"))))
163 | 
164 | (defun forge-discussion-at-point (&optional demand)
165 |   "Return the discussion at point.
166 | If there is no such discussion and DEMAND is non-nil, then signal
167 | an error."
168 |   (or (thing-at-point 'forge-discussion)
169 |       (magit-section-value-if 'discussion)
170 |       (and demand (user-error "No discussion at point"))))
171 | 
172 | (put 'forge-discussion 'thing-at-point #'forge-thingatpt--discussion)
173 | (defun forge-thingatpt--discussion ()
174 |   (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>"))
175 |              (number (string-to-number (match-string 1)))
176 |              (repo (forge--repo-for-thingatpt)))
177 |     (forge-get-discussion repo number)))
178 | 
179 | ;;; Read
180 | 
181 | (defun forge-read-discussion (prompt)
182 |   "Read an active discussion with completion using PROMPT.
183 | 
184 | Open, unread and pending discussions are considered active.
185 | Default to the current discussion, even if it isn't active.
186 | 
187 | \\<forge-read-topic-minibuffer-map>While completion is in \
188 | progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
189 | the completion candidates to include all discussions.
190 | 
191 | If `forge-limit-topic-choices' is nil, then all candidates
192 | can be selected from the start."
193 |   (forge--read-topic prompt
194 |                      #'forge-current-discussion
195 |                      (forge--topics-spec :type 'discussion :active t)
196 |                      (forge--topics-spec :type 'discussion :active nil :state nil)))
197 | 
198 | (defun forge-read-topic-category (&optional topic prompt)
199 |   (magit-completing-read
200 |    (or prompt "Category")
201 |    (mapcar #'caddr
202 |            (oref (forge-get-repository (or topic :tracked))
203 |                  discussion-categories))
204 |    nil t
205 |    (and topic (forge--format-topic-category topic))))
206 | 
207 | (defun forge--select-discussion-answer (topic)
208 |   (if-let ((post (forge-post-at-point)))
209 |       (cond ((forge-discussion-p (forge-post-at-point))
210 |              (user-error "Cannot pick the question as its own answer"))
211 |             ((and-let* ((answer (oref topic answer)))
212 |                (equal (oref post their-id)
213 |                       (forge--their-id answer)))
214 |              nil)
215 |             (post))
216 |     (user-error "Point must be on an reply to mark it as the answer")))
217 | 
218 | (defun forge--select-discussion-reply-target ()
219 |   (if-let ((answers (oref forge-buffer-topic posts)))
220 |       (let* ((format-answer
221 |               (lambda (answer)
222 |                 (let ((text (oref answer body)))
223 |                   (save-match-data
224 |                     (cons (format "Reply to answer %S"
225 |                                   (if (string-match "\n" text)
226 |                                       (substring text 0 (match-beginning 0))
227 |                                     text))
228 |                           answer)))))
229 |              (post (forge-post-at-point))
230 |              (answer (if (forge-discussion-reply-p post)
231 |                          (magit-section-parent-value
232 |                           (magit-current-section))
233 |                        post))
234 |              (default (and answer (funcall format-answer answer)))
235 |              (choices `(("Add new top-level answer" . ,forge-buffer-topic)
236 |                         ,@(mapcar format-answer answers))))
237 |         (cdr (assoc (magit-completing-read "Reply to: "
238 |                                            choices nil t nil nil default)
239 |                     choices)))
240 |     forge-buffer-topic))
241 | 
242 | ;;; Insert
243 | 
244 | (defvar-keymap forge-discussions-section-map
245 |   "<remap> <magit-browse-thing>" #'forge-browse-discussions
246 |   "<remap> <magit-visit-thing>"  #'forge-list-discussions
247 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
248 |   "<remap> <forge--item-menu>"   #'forge-topic-menu
249 |   "C-c C-n"                      #'forge-create-discussion)
250 | 
251 | (defvar-keymap forge-discussion-section-map
252 |   :parent forge-common-map
253 |   "<remap> <magit-visit-thing>"  #'forge-visit-this-topic
254 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
255 |   "<remap> <forge--item-menu>"   #'forge-topic-menu)
256 | 
257 | (cl-defun forge-insert-discussions (&optional (spec nil sspec) heading)
258 |   "Insert a list of discussions, according to `forge--buffer-topics-spec'.
259 | Optional SPEC can be used to override that filtering specification,
260 | and optional HEADING to change the section heading."
261 |   (when-let (((forge-db t))
262 |              (repo (forge-get-repository :tracked?))
263 |              ((oref repo discussions-p))
264 |              (spec (if sspec spec (forge--clone-buffer-topics-spec)))
265 |              ((memq (oref spec type) '(topic discussion))))
266 |     (oset spec type 'discussion)
267 |     (forge--insert-topics 'discussions
268 |                           (or heading "Discussions")
269 |                           (forge--list-topics spec repo))))
270 | 
271 | ;;; _
272 | ;; Local Variables:
273 | ;; read-symbol-shorthands: (
274 | ;;   ("partial" . "llama--left-apply-partially")
275 | ;;   ("rpartial" . "llama--right-apply-partially"))
276 | ;; End:
277 | (provide 'forge-discussion)
278 | ;;; forge-discussion.el ends here
279 | 


--------------------------------------------------------------------------------
/lisp/forge-forgejo.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-forgejo.el --- Forgejo support  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'forge)
26 | 
27 | ;;; Class
28 | 
29 | (defclass forge-forgejo-repository (forge-unusedapi-repository)
30 |   ((issues-url-format         :initform "https://%h/%o/%n/issues")
31 |    (issue-url-format          :initform "https://%h/%o/%n/issues/%i")
32 |    ;; The anchor for the issue itself is .../%i#issue-%i
33 |    (issue-post-url-format     :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
34 |    (pullreqs-url-format       :initform "https://%h/%o/%n/pulls")
35 |    (pullreq-url-format        :initform "https://%h/%o/%n/pulls/%i")
36 |    (pullreq-post-url-format   :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
37 |    (commit-url-format         :initform "https://%h/%o/%n/commit/%r")
38 |    (branch-url-format         :initform "https://%h/%o/%n/commits/branch/%r")
39 |    (remote-url-format         :initform "https://%h/%o/%n")
40 |    (blob-url-format           :initform "https://%h/%o/%n/src/%r/%f")
41 |    (create-issue-url-format   :initform "https://%h/%o/%n/issues/new")
42 |    (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
43 |    (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
44 | 
45 | ;;; _
46 | (provide 'forge-forgejo)
47 | ;;; forge-forgejo.el ends here
48 | 


--------------------------------------------------------------------------------
/lisp/forge-gitea.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-gitea.el --- Gitea support  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'gtea)
26 | (require 'forge)
27 | 
28 | ;;; Class
29 | 
30 | (defclass forge-gitea-repository (forge-unusedapi-repository)
31 |   ((issues-url-format         :initform "https://%h/%o/%n/issues")
32 |    (issue-url-format          :initform "https://%h/%o/%n/issues/%i")
33 |    ;; The anchor for the issue itself is .../%i#issue-%i
34 |    (issue-post-url-format     :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
35 |    (pullreqs-url-format       :initform "https://%h/%o/%n/pulls")
36 |    (pullreq-url-format        :initform "https://%h/%o/%n/pulls/%i")
37 |    (pullreq-post-url-format   :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
38 |    (commit-url-format         :initform "https://%h/%o/%n/commit/%r")
39 |    (branch-url-format         :initform "https://%h/%o/%n/commits/branch/%r")
40 |    (remote-url-format         :initform "https://%h/%o/%n")
41 |    (blob-url-format           :initform "https://%h/%o/%n/src/%r/%f")
42 |    (create-issue-url-format   :initform "https://%h/%o/%n/issues/new")
43 |    (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
44 |    (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
45 | 
46 | ;;; _
47 | (provide 'forge-gitea)
48 | ;;; forge-gitea.el ends here
49 | 


--------------------------------------------------------------------------------
/lisp/forge-gogs.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-gogs.el --- Gogs support  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'gogs)
26 | (require 'forge)
27 | 
28 | ;;; Class
29 | 
30 | (defclass forge-gogs-repository (forge-unusedapi-repository)
31 |   ((issues-url-format         :initform "https://%h/%o/%n/issues")
32 |    (issue-url-format          :initform "https://%h/%o/%n/issues/%i")
33 |    (issue-post-url-format     :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
34 |    (pullreqs-url-format       :initform "https://%h/%o/%n/pulls")
35 |    (pullreq-url-format        :initform "https://%h/%o/%n/pulls/%i")
36 |    (pullreq-post-url-format   :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
37 |    (commit-url-format         :initform "https://%h/%o/%n/commit/%r")
38 |    (branch-url-format         :initform "https://%h/%o/%n/commits/%r")
39 |    (remote-url-format         :initform "https://%h/%o/%n")
40 |    (blob-url-format           :initform "https://%h/%o/%n/src/%r/%f")
41 |    (create-issue-url-format   :initform "https://%h/%o/%n/issues/new")
42 |    (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
43 |    (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
44 | 
45 | ;;; _
46 | (provide 'forge-gogs)
47 | ;;; forge-gogs.el ends here
48 | 


--------------------------------------------------------------------------------
/lisp/forge-issue.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-issue.el --- Issue support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'forge)
 26 | (require 'forge-post)
 27 | (require 'forge-topic)
 28 | 
 29 | ;;; Classes
 30 | 
 31 | (defclass forge-issue (forge-topic)
 32 |   ((closql-table         :initform 'issue)
 33 |    (closql-primary-key   :initform 'id)
 34 |    (closql-order-by      :initform [(desc number)])
 35 |    (closql-foreign-key   :initform 'repository)
 36 |    (closql-class-prefix  :initform "forge-")
 37 |    (id                   :initarg :id)
 38 |    (repository           :initarg :repository)
 39 |    (number               :initarg :number)
 40 |    (state                :initarg :state)
 41 |    (author               :initarg :author)
 42 |    (title                :initarg :title)
 43 |    (created              :initarg :created)
 44 |    (updated              :initarg :updated :initform nil)
 45 |    (closed               :initarg :closed)
 46 |    (status               :initarg :status :initform nil)
 47 |    (locked-p             :initarg :locked-p)
 48 |    (milestone            :initarg :milestone)
 49 |    (body                 :initarg :body)
 50 |    (assignees            :closql-tables (issue-assignee assignee))
 51 |    (project-cards) ; projectsCards
 52 |    (edits) ; userContentEdits
 53 |    (labels               :closql-tables (issue-label label))
 54 |    (participants)
 55 |    (posts                :closql-class forge-issue-post)
 56 |    (reactions)
 57 |    (timeline)
 58 |    (marks                :closql-tables (issue-mark mark))
 59 |    (note                 :initarg :note :initform nil)
 60 |    (their-id             :initarg :their-id)
 61 |    (slug                 :initarg :slug)
 62 |    (saved-p              :initarg :saved-p :initform nil)
 63 |    ))
 64 | 
 65 | (cl-defmethod closql-dref ((obj forge-issue) (_(eql assignees)))
 66 |   (forge-sql-cdr
 67 |    [:select assignee:* :from assignee
 68 |     :join issue-assignee :on (= issue-assignee:id assignee:id)
 69 |     :where (= issue-assignee:issue $s1)
 70 |     :order-by [(asc login)]]
 71 |    (closql--oref obj 'id)))
 72 | 
 73 | (cl-defmethod closql-dref ((obj forge-issue) (_(eql labels)))
 74 |   (forge-sql-cdr
 75 |    [:select label:* :from label
 76 |     :join issue-label :on (= issue-label:id label:id)
 77 |     :where (= issue-label:issue $s1)
 78 |     :order-by [(asc name)]]
 79 |    (closql--oref obj 'id)))
 80 | 
 81 | (cl-defmethod closql-dref ((obj forge-issue) (_(eql marks)))
 82 |   (forge-sql-cdr
 83 |    [:select mark:* :from mark
 84 |     :join issue-mark :on (= issue-mark:id mark:id)
 85 |     :where (= issue-mark:issue $s1)
 86 |     :order-by [(asc name)]]
 87 |    (closql--oref obj 'id)))
 88 | 
 89 | (defclass forge-issue-post (forge-post)
 90 |   ((closql-table         :initform 'issue-post)
 91 |    (closql-primary-key   :initform 'id)
 92 |    (closql-order-by      :initform [(asc number)])
 93 |    (closql-foreign-key   :initform 'issue)
 94 |    (closql-class-prefix  :initform "forge-issue-")
 95 |    (id                   :initarg :id)
 96 |    (issue                :initarg :issue)
 97 |    (number               :initarg :number)
 98 |    (author               :initarg :author)
 99 |    (created              :initarg :created)
100 |    (updated              :initarg :updated)
101 |    (body                 :initarg :body)
102 |    (edits)
103 |    (reactions)
104 |    ))
105 | 
106 | ;;; Query
107 | ;;;; Get
108 | 
109 | (cl-defmethod forge-get-repository ((post forge-issue-post))
110 |   (forge-get-repository (forge-get-issue post)))
111 | 
112 | (cl-defmethod forge-get-topic ((post forge-issue-post))
113 |   (forge-get-issue post))
114 | 
115 | (cl-defmethod forge-get-issue ((issue forge-issue))
116 |   issue)
117 | 
118 | (cl-defmethod forge-get-issue ((repo forge-repository) number)
119 |   (closql-get (forge-db)
120 |               (forge--object-id 'forge-issue repo number)
121 |               'forge-issue))
122 | 
123 | (cl-defmethod forge-get-issue ((number integer))
124 |   (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
125 |     (forge-get-issue repo number)))
126 | 
127 | (cl-defmethod forge-get-issue ((id string))
128 |   (closql-get (forge-db) id 'forge-issue))
129 | 
130 | (cl-defmethod forge-get-issue ((post forge-issue-post))
131 |   (closql-get (forge-db)
132 |               (oref post issue)
133 |               'forge-issue))
134 | 
135 | ;;;; Current
136 | 
137 | (defun forge-current-issue (&optional demand)
138 |   "Return the issue at point or being visited.
139 | If there is no such issue and DEMAND is non-nil, then signal
140 | an error."
141 |   (or (forge-issue-at-point)
142 |       (and (forge-issue-p forge-buffer-topic)
143 |            forge-buffer-topic)
144 |       (and demand (user-error "No current issue"))))
145 | 
146 | (defun forge-issue-at-point (&optional demand)
147 |   "Return the issue at point.
148 | If there is no such issue and DEMAND is non-nil, then signal
149 | an error."
150 |   (or (thing-at-point 'forge-issue)
151 |       (magit-section-value-if 'issue)
152 |       (and demand (user-error "No issue at point"))))
153 | 
154 | (put 'forge-issue 'thing-at-point #'forge-thingatpt--issue)
155 | (defun forge-thingatpt--issue ()
156 |   (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>"))
157 |              (number (string-to-number (match-string 1)))
158 |              (repo (forge--repo-for-thingatpt)))
159 |     (forge-get-issue repo number)))
160 | 
161 | ;;; Read
162 | 
163 | (defun forge-read-issue (prompt)
164 |   "Read an active issue with completion using PROMPT.
165 | 
166 | Open, unread and pending issues are considered active.
167 | Default to the current issue, even if it isn't active.
168 | 
169 | \\<forge-read-topic-minibuffer-map>While completion is in \
170 | progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
171 | the completion candidates to include all issues.
172 | 
173 | If `forge-limit-topic-choices' is nil, then all candidates
174 | can be selected from the start."
175 |   (forge--read-topic prompt
176 |                      #'forge-current-issue
177 |                      (forge--topics-spec :type 'issue :active t)
178 |                      (forge--topics-spec :type 'issue :active nil :state nil)))
179 | 
180 | (defun forge-read-open-issue (prompt)
181 |   "Read an open issue with completion using PROMPT."
182 |   (let* ((current (forge-current-issue))
183 |          (repo    (forge-get-repository (or current :tracked)))
184 |          (default (and current (forge--format-topic-line current)))
185 |          (alist   (forge--topic-collection
186 |                    (forge--list-topics
187 |                     (forge--topics-spec :type 'issue :state 'open)
188 |                     repo)))
189 |          (choices (mapcar #'car alist))
190 |          (choice  (magit-completing-read prompt choices nil t nil nil default)))
191 |     (cdr (assoc choice alist))))
192 | 
193 | ;;; Insert
194 | 
195 | (defvar-keymap forge-issues-section-map
196 |   :parent forge-common-map
197 |   "<remap> <magit-browse-thing>" #'forge-browse-issues
198 |   "<remap> <magit-visit-thing>"  #'forge-list-issues
199 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
200 |   "<remap> <forge--item-menu>"   #'forge-topic-menu
201 |   "C-c C-n"                      #'forge-create-issue)
202 | 
203 | (defvar-keymap forge-issue-section-map
204 |   :parent forge-common-map
205 |   "<remap> <magit-visit-thing>"  #'forge-visit-this-topic
206 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
207 |   "<remap> <forge--item-menu>"   #'forge-topic-menu)
208 | 
209 | (cl-defun forge-insert-issues (&optional (spec nil sspec) heading)
210 |   "Insert a list of issues, according to `forge--buffer-topics-spec'.
211 | Optional SPEC can be used to override that filtering specification,
212 | and optional HEADING to change the section heading."
213 |   (when-let (((forge-db t))
214 |              (repo (forge-get-repository :tracked?))
215 |              ((oref repo issues-p))
216 |              (spec (if sspec spec (forge--clone-buffer-topics-spec)))
217 |              ((memq (oref spec type) '(topic issue))))
218 |     (oset spec type 'issue)
219 |     (forge--insert-topics 'issues
220 |                           (or heading "Issues")
221 |                           (forge--list-topics spec repo))))
222 | 
223 | ;;; _
224 | ;; Local Variables:
225 | ;; read-symbol-shorthands: (
226 | ;;   ("partial" . "llama--left-apply-partially")
227 | ;;   ("rpartial" . "llama--right-apply-partially"))
228 | ;; End:
229 | (provide 'forge-issue)
230 | ;;; forge-issue.el ends here
231 | 


--------------------------------------------------------------------------------
/lisp/forge-notify.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-notify.el --- Notify support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'forge)
 26 | (require 'forge-topic)
 27 | 
 28 | ;;; Class
 29 | 
 30 | (defclass forge-notification (forge-object)
 31 |   ((closql-class-prefix       :initform "forge-")
 32 |    (closql-table              :initform 'notification)
 33 |    (closql-primary-key        :initform 'id)
 34 |    (closql-order-by           :initform [(desc id)])
 35 |    (id                        :initarg :id)
 36 |    (thread-id                 :initarg :thread-id)
 37 |    (repository                :initarg :repository)
 38 |    (type                      :initarg :type)
 39 |    (topic                     :initarg :topic)
 40 |    (url                       :initarg :url)
 41 |    (title                     :initarg :title)
 42 |    (reason                    :initarg :reason)
 43 |    (last-read                 :initarg :last-read)
 44 |    (updated                   :initarg :updated)))
 45 | 
 46 | ;;; Query
 47 | ;;;; Get
 48 | 
 49 | (cl-defmethod forge-get-repository ((notify forge-notification))
 50 |   "Return the object for the repository that NOTIFY belongs to."
 51 |   (and-let* ((id (oref notify repository)))
 52 |     (closql-get (forge-db) id 'forge-repository)))
 53 | 
 54 | (cl-defmethod forge-get-topic ((notify forge-notification))
 55 |   (and-let* ((repo (forge-get-repository notify)))
 56 |     (forge-get-topic repo (oref notify topic))))
 57 | 
 58 | (cl-defmethod forge-get-notification ((id string))
 59 |   (closql-get (forge-db) id 'forge-notification))
 60 | 
 61 | (cl-defmethod forge-get-notification ((topic forge-topic))
 62 |   (and-let* ((row (car (forge-sql [:select * :from notification
 63 |                                    :where (and (= repository $s1)
 64 |                                                (= topic $s2))]
 65 |                                   (oref topic repository)
 66 |                                   (oref topic number)))))
 67 |     (closql--remake-instance 'forge-notification (forge-db) row)))
 68 | 
 69 | ;;;; Current
 70 | 
 71 | (defun forge-current-notification (&optional demand)
 72 |   "Return the current notification, casting a topic if necessary.
 73 | If there is no such notification and DEMAND is non-nil, then
 74 | signal an error."
 75 |   (or (magit-section-value-if 'notification)
 76 |       (and-let* ((topic (forge-current-topic)))
 77 |         (forge-get-notification topic))
 78 |       (and demand (user-error "No current notification"))))
 79 | 
 80 | (defun forge-notification-at-point (&optional demand)
 81 |   "Return the notification at point, casting a topic if necessary.
 82 | If there is no such notification and DEMAND is non-nil, then
 83 | signal an error."
 84 |   (or (magit-section-value-if 'notification)
 85 |       (and-let* ((topic (forge-topic-at-point)))
 86 |         (forge-get-notification topic))
 87 |       (and demand (user-error "No notification at point"))))
 88 | 
 89 | ;;;; List
 90 | 
 91 | (defun forge--ls-notifications (status)
 92 |   (let* ((status (ensure-list status))
 93 |          (savedp (memq 'saved status))
 94 |          (status (remq 'saved status)))
 95 |     (mapcar
 96 |      (partial #'closql--remake-instance 'forge-notification (forge-db))
 97 |      (if (seq-set-equal-p status '(unread pending done) #'eq)
 98 |          (forge-sql [:select * :from notification :order-by [(desc updated)]])
 99 |        (forge-sql
100 |         `[:select :distinct notification:*
101 |           :from [notification (as issue topic)]
102 |           :where (and (= notification:topic topic:id)
103 |                       ,@(and status '((in topic:status $v1)))
104 |                       ,@(and savedp '((= topic:saved-p 't))))
105 |           :union
106 |           :select :distinct notification:*
107 |           :from [notification (as pullreq topic)]
108 |           :where (and (= notification:topic topic:id)
109 |                       ,@(and status '((in topic:status $v1)))
110 |                       ,@(and savedp '((= topic:saved-p 't))))
111 |           :order-by [(desc notification:updated)]]
112 |         (vconcat status))))))
113 | 
114 | ;;; Mode
115 | 
116 | (defvar-keymap forge-notifications-mode-map
117 |   :doc "Keymap for `forge-notifications-mode'."
118 |   :parent (make-composed-keymap forge-common-map magit-mode-map)
119 |   "<remap> <magit-refresh>"    #'magit-refresh-buffer
120 |   "<remap> <forge--list-menu>" #'forge-notifications-menu)
121 | 
122 | (define-derived-mode forge-notifications-mode magit-mode "Forge Notifications"
123 |   "Major mode for looking at forge notifications."
124 |   :interactive nil
125 |   (magit-hack-dir-local-variables))
126 | 
127 | (defun forge-notifications-setup-buffer ()
128 |   (magit-setup-buffer-internal #'forge-notifications-mode nil
129 |                                '((default-directory "/")
130 |                                  (forge-buffer-unassociated-p t))
131 |                                (get-buffer-create "*forge-notifications*")))
132 | 
133 | (defun forge-notifications-refresh-buffer ()
134 |   (magit-set-header-line-format (forge-notifications-buffer-desc))
135 |   (forge-insert-notifications))
136 | 
137 | (defun forge-notifications-buffer-desc ()
138 |   (let ((status forge-notifications-selection))
139 |     (cond
140 |      ((not (listp status))
141 |       (format "%s notifications" (capitalize (symbol-name status))))
142 |      ((seq-set-equal-p status '(unread pending)) "Inbox")
143 |      ((seq-set-equal-p status '(unread pending done)) "All notifications")
144 |      ((format "Notifications %s" status)))))
145 | 
146 | (defvar forge-notifications-display-style 'flat)
147 | (defvar forge-notifications-selection '(unread pending))
148 | 
149 | ;;; Commands
150 | 
151 | (transient-define-prefix forge-notifications-menu ()
152 |   "Control list of notifications and notification at point."
153 |   :transient-suffix t
154 |   :transient-non-suffix #'transient--do-call
155 |   :transient-switch-frame nil
156 |   :refresh-suffixes t
157 |   :environment #'forge--menu-environment
158 |   :column-widths forge--topic-menus-column-widths
159 |   [:hide always ("q" forge-menu-quit-list)]
160 |   [forge--topic-menus-group
161 |    ["Selection"
162 |     ("I" forge-notifications-display-inbox)
163 |     ("S" forge-notifications-display-saved)
164 |     ("D" forge-notifications-display-done)
165 |     ("A" forge-notifications-display-all)]]
166 |   [forge--lists-group
167 |    ["Display"
168 |     ("-F" forge-notifications-style-flat)
169 |     ("-G" forge-notifications-style-nested)
170 |     ("-H" forge-toggle-topic-legend)]]
171 |   [forge--topic-legend-group]
172 |   (interactive)
173 |   (unless (derived-mode-p 'forge-notifications-mode)
174 |     (forge-list-notifications))
175 |   (transient-setup 'forge-notifications-menu))
176 | 
177 | (transient-augment-suffix forge-notifications-menu
178 |   :transient #'transient--do-replace
179 |   :if-mode 'forge-notifications-mode
180 |   :inapt-if (##eq (oref transient--prefix command) 'forge-notifications-menu)
181 |   :inapt-face 'forge-suffix-active)
182 | 
183 | ;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t)
184 | (transient-define-suffix forge-list-notifications ()
185 |   "List notifications."
186 |   :inapt-if-mode 'forge-notifications-mode
187 |   :inapt-face 'forge-suffix-active
188 |   (declare (interactive-only nil))
189 |   (interactive)
190 |   (forge-notifications-setup-buffer)
191 |   (transient-setup 'forge-notifications-menu))
192 | 
193 | (transient-define-suffix forge-notifications-display-inbox ()
194 |   "List unread and pending notifications."
195 |   :description "inbox"
196 |   :inapt-if (##equal forge-notifications-selection '(unread pending))
197 |   :inapt-face 'forge-suffix-active
198 |   (interactive)
199 |   (unless (derived-mode-p 'forge-notifications-mode)
200 |     (user-error "Not in notification buffer"))
201 |   (setq forge-notifications-selection '(unread pending))
202 |   (forge-refresh-buffer))
203 | 
204 | (transient-define-suffix forge-notifications-display-saved ()
205 |   "List saved notifications."
206 |   :description "saved"
207 |   :inapt-if (##eq forge-notifications-selection 'saved)
208 |   :inapt-face 'forge-suffix-active
209 |   (interactive)
210 |   (unless (derived-mode-p 'forge-notifications-mode)
211 |     (user-error "Not in notification buffer"))
212 |   (setq forge-notifications-selection 'saved)
213 |   (forge-refresh-buffer))
214 | 
215 | (transient-define-suffix forge-notifications-display-done ()
216 |   "List done notifications."
217 |   :description "done"
218 |   :inapt-if (##eq forge-notifications-selection 'done)
219 |   :inapt-face 'forge-suffix-active
220 |   (interactive)
221 |   (unless (derived-mode-p 'forge-notifications-mode)
222 |     (user-error "Not in notification buffer"))
223 |   (setq forge-notifications-selection 'done)
224 |   (forge-refresh-buffer))
225 | 
226 | (transient-define-suffix forge-notifications-display-all ()
227 |   "List all notifications."
228 |   :description "all"
229 |   :inapt-if (##equal forge-notifications-selection '(unread pending done))
230 |   :inapt-face 'forge-suffix-active
231 |   (interactive)
232 |   (unless (derived-mode-p 'forge-notifications-mode)
233 |     (user-error "Not in notification buffer"))
234 |   (setq forge-notifications-selection '(unread pending done))
235 |   (forge-refresh-buffer))
236 | 
237 | (transient-define-suffix forge-notifications-style-flat ()
238 |   "Show a flat notification list."
239 |   :description "single list"
240 |   :inapt-if (##eq forge-notifications-display-style 'flat)
241 |   :inapt-face 'forge-suffix-active
242 |   (interactive)
243 |   (unless (derived-mode-p 'forge-notifications-mode)
244 |     (user-error "Not in notification buffer"))
245 |   (setq forge-notifications-display-style 'flat)
246 |   (forge-refresh-buffer))
247 | 
248 | (transient-define-suffix forge-notifications-style-nested ()
249 |   "Group notifications by repository."
250 |   :description "group by repo"
251 |   :inapt-if (##eq forge-notifications-display-style 'nested)
252 |   :inapt-face 'forge-suffix-active
253 |   (interactive)
254 |   (unless (derived-mode-p 'forge-notifications-mode)
255 |     (user-error "Not in notification buffer"))
256 |   (setq forge-notifications-display-style 'nested)
257 |   (forge-refresh-buffer))
258 | 
259 | ;;; Sections
260 | 
261 | (defclass forge-repository-section (magit-section)
262 |   ((type   :initform 'forge-repo)
263 |    (keymap :initform 'forge-repository-section-map)))
264 | 
265 | (define-obsolete-variable-alias 'forge-forge-repo-section-map
266 |   'forge-repository-section-map "Forge 0.4.0")
267 | 
268 | (defvar-keymap forge-repository-section-map
269 |   "<remap> <magit-browse-thing>" #'forge-browse-this-repository
270 |   "<remap> <magit-visit-thing>"  #'forge-visit-this-repository)
271 | 
272 | (defun forge-insert-notifications ()
273 |   (let ((notifs (forge--ls-notifications forge-notifications-selection)))
274 |     (magit-insert-section (notifications)
275 |       (cond
276 |        ((not notifs)
277 |         (insert "(empty)\n"))
278 |        ((eq forge-notifications-display-style 'flat)
279 |         (magit-insert-section-body
280 |           (dolist (notif notifs)
281 |             (forge-insert-notification notif))
282 |           (insert ?\n)))
283 |        ((pcase-dolist (`(,_ . ,notifs)
284 |                        (seq-group-by (##oref % repository) notifs))
285 |           (let ((repo (forge-get-repository (car notifs))))
286 |             (magit-insert-section (forge-repo repo)
287 |               (magit-insert-heading
288 |                 (concat (propertize (oref repo slug) 'font-lock-face 'bold)
289 |                         (format " (%s)" (length notifs))))
290 |               (magit-insert-section-body
291 |                 (dolist (notif notifs)
292 |                   (forge-insert-notification notif))
293 |                 (insert ?\n))))))))))
294 | 
295 | (defun forge-insert-notification (notif)
296 |   (with-slots (type title url) notif
297 |     (pcase type
298 |       ((or 'discussion 'issue 'pullreq)
299 |        (forge--insert-topic (forge-get-topic notif)))
300 |       ('commit
301 |        (magit-insert-section (ncommit nil) ; !commit
302 |          (string-match "[^/]*\\'" url)
303 |          (insert
304 |           (format "%s %s\n"
305 |                   (propertize (substring (match-string 0 url)
306 |                                          0 (magit-abbrev-length))
307 |                               'font-lock-face 'magit-hash)
308 |                   (magit-log--wash-summary
309 |                    (propertize title 'font-lock-face
310 |                                (if-let* ((topic (oref notif topic))
311 |                                          ((eq (oref topic status) 'unread)))
312 |                                    'forge-topic-unread
313 |                                  'forge-topic-open)))))))
314 |       (_
315 |        ;; The documentation does not mention what "types"
316 |        ;; exist.  Make it obvious that this is something
317 |        ;; we do not know how to handle properly yet.
318 |        (magit-insert-section (notification notif)
319 |          (insert (propertize (format "(%s) %s\n" type title)
320 |                              'font-lock-face 'error)))))))
321 | 
322 | ;;; _
323 | ;; Local Variables:
324 | ;; read-symbol-shorthands: (
325 | ;;   ("partial" . "llama--left-apply-partially")
326 | ;;   ("rpartial" . "llama--right-apply-partially"))
327 | ;; End:
328 | (provide 'forge-notify)
329 | ;;; forge-notify.el ends here
330 | 


--------------------------------------------------------------------------------
/lisp/forge-post.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-post.el --- Post support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'markdown-mode)
 26 | 
 27 | (require 'forge)
 28 | 
 29 | ;;; Options
 30 | 
 31 | (defcustom forge-post-mode-hook
 32 |   '(visual-line-mode
 33 |     turn-on-flyspell)
 34 |   "Hook run after entering Forge-Post mode."
 35 |   :package-version '(forge . "0.2.0")
 36 |   :group 'forge
 37 |   :type 'hook
 38 |   :options '(visual-line-mode
 39 |              turn-on-flyspell))
 40 | 
 41 | (defcustom forge-post-fallback-directory
 42 |   (locate-user-emacs-file "forge-drafts/")
 43 |   "Directory used to store post drafts for locally unavailable repositories.
 44 | Normally drafts are stored inside the Git directory.  If that does not
 45 | exist (or its location is unknown), then this directory is used instead."
 46 |   :package-version '(forge . "0.4.7")
 47 |   :group 'forge
 48 |   :type 'directory)
 49 | 
 50 | ;;; Class
 51 | 
 52 | (defclass forge-post (forge-object) () :abstract t)
 53 | 
 54 | ;;; Query
 55 | ;;;; Get
 56 | 
 57 | (cl-defmethod forge-get-parent ((post forge-post))
 58 |   (forge-get-topic post))
 59 | 
 60 | (cl-defmethod forge-get-repository ((post forge-post))
 61 |   (forge-get-repository (forge-get-topic post)))
 62 | 
 63 | ;;;; Current
 64 | 
 65 | (defun forge-post-at-point (&optional assert)
 66 |   "Return the post at point.
 67 | If there is no such post and DEMAND is non-nil, then signal
 68 | an error."
 69 |   (or (magit-section-value-if '(issue pullreq post))
 70 |       (and assert (user-error "There is no post at point"))))
 71 | 
 72 | (defun forge-comment-at-point (&optional assert)
 73 |   "Return the comment at point.
 74 | If there is no such comment and DEMAND is non-nil, then signal
 75 | an error."
 76 |   (or (and (magit-section-value-if '(post))
 77 |            (let ((post (oref (magit-current-section) value)))
 78 |              (and (or (forge-pullreq-post-p post)
 79 |                       (forge-issue-post-p post))
 80 |                   post)))
 81 |       (and assert (user-error "There is no comment at point"))))
 82 | 
 83 | ;;; Utilities
 84 | 
 85 | (cl-defmethod forge--format ((post forge-post) slot &optional spec)
 86 |   (forge--format (forge-get-topic post) slot
 87 |                  `(,@spec (?I . ,(oref post number)))))
 88 | 
 89 | ;;; Mode
 90 | 
 91 | (defvar-keymap forge-post-mode-map
 92 |   "<remap> <forge--item-menu>"             #'forge-post-menu
 93 |   "C-c C-e"                                #'forge-post-menu
 94 |   "C-c C-c"                                #'forge-post-submit
 95 |   "<remap> <evil-save-and-close>"          #'forge-post-submit
 96 |   "<remap> <evil-save-modified-and-close>" #'forge-post-submit
 97 |   "C-c C-k"                                #'forge-post-cancel
 98 |   "<remap> <kill-buffer>"                  #'forge-post-cancel
 99 |   "<remap> <ido-kill-buffer>"              #'forge-post-cancel
100 |   "<remap> <iswitchb-kill-buffer>"         #'forge-post-cancel
101 |   "<remap> <evil-quit>"                    #'forge-post-cancel)
102 | 
103 | (define-derived-mode forge-post-mode gfm-mode "Forge-Post"
104 |   "Major mode for editing topic posts."
105 |   :interactive nil)
106 | 
107 | (defvar-local forge--pre-post-buffer nil)
108 | 
109 | (defvar-local forge--submit-post-function nil)
110 | (defvar-local forge--cancel-post-function nil)
111 | 
112 | (defvar-local forge--buffer-post-object nil)
113 | (defvar-local forge--buffer-template nil)
114 | (defvar-local forge--buffer-category nil)
115 | (defvar-local forge--buffer-milestone nil)
116 | (defvar-local forge--buffer-labels nil)
117 | (defvar-local forge--buffer-assignees nil)
118 | (defvar-local forge--buffer-base-branch nil)
119 | (defvar-local forge--buffer-head-branch nil)
120 | (defvar-local forge--buffer-draft-p nil)
121 | 
122 | (defun forge--setup-post-buffer (obj submit file header &optional bindings fn)
123 |   (declare (indent defun))
124 |   (let* ((prevbuf (current-buffer))
125 |          (obj     (or obj (forge-get-repository :tracked)))
126 |          (repo    (forge-get-repository obj))
127 |          (header  (forge--format obj header))
128 |          (file    (forge--post-expand-file-name file repo))
129 |          (_       (make-directory (file-name-directory file) t))
130 |          (buffer  (find-file-noselect file))
131 |          (resume  (forge--post-resume-p file buffer)))
132 |     (with-current-buffer buffer
133 |       (forge-post-mode)
134 |       (magit-set-header-line-format header)
135 |       (setq forge--pre-post-buffer prevbuf)
136 |       (forge-set-buffer-repository)
137 |       (setq forge--buffer-post-object obj)
138 |       (setq forge--submit-post-function submit)
139 |       (pcase-dolist (`(,var ,val) bindings)
140 |         (set (make-local-variable var) val)
141 |         (when (eq var 'forge--buffer-template)
142 |           (let-alist forge--buffer-template
143 |             (setq forge--buffer-assignees .assignees)
144 |             (setq forge--buffer-labels .labels)
145 |             (setq forge--buffer-draft-p .draft))))
146 |       (when (and (not resume) forge--buffer-template)
147 |         (forge--post-insert-template forge--buffer-template))
148 |       (when fn
149 |         (funcall fn))
150 |       (run-hooks 'forge-edit-post-hook))
151 |     (message (substitute-command-keys
152 |               "Use \\[forge-post-menu] to set fields and submit or abort"))
153 |     (forge--display-post-buffer buffer)))
154 | 
155 | (defun forge--display-post-buffer (buf)
156 |   (magit-display-buffer buf #'display-buffer))
157 | 
158 | (defun forge--post-expand-file-name (file repo)
159 |   (if-let ((worktree (oref repo worktree)))
160 |       (expand-file-name (concat "magit/posts/" file) (magit-gitdir worktree))
161 |     (expand-file-name (with-slots (githost owner name) repo
162 |                         (format "%s_%s-%s_%s" githost owner name file))
163 |                       forge-post-fallback-directory)))
164 | 
165 | (defun forge--post-resume-p (file buffer)
166 |   (and (file-exists-p file)
167 |        (> (file-attribute-size (file-attributes file)) 0)
168 |        (progn (forge--display-post-buffer buffer)
169 |               (or (magit-read-char-case "" nil
170 |                     (?r "[r]esume editing this draft" t)
171 |                     (?d "[d]iscard and start over?"))
172 |                   (progn (erase-buffer)
173 |                          nil)))))
174 | 
175 | (defun forge--post-insert-template (template)
176 |   (let-alist template
177 |     (cond
178 |      (.name
179 |       ;; A Github issue with yaml frontmatter.
180 |       (save-excursion (insert .text))
181 |       (unless (re-search-forward "^title: " nil t)
182 |         (when (re-search-forward "^---" nil t 2)
183 |           (beginning-of-line)
184 |           (insert "title: \n")
185 |           (backward-char))))
186 |      (t
187 |       (insert "# ")
188 |       (let* ((source (alist-get 'source template))
189 |              (target (alist-get 'target template))
190 |              (single (and source
191 |                           (= (car (magit-rev-diff-count source target)) 1))))
192 |         (save-excursion
193 |           (when single
194 |             ;; A pull-request.
195 |             (magit-rev-insert-format "%B" source))
196 |           (when .text
197 |             (if single
198 |                 (insert "-------\n")
199 |               (insert "\n"))
200 |             (insert "\n" .text))))))))
201 | 
202 | (defun forge--post-buffer-text ()
203 |   (save-match-data
204 |     (save-excursion
205 |       (goto-char (point-min))
206 |       (skip-chars-forward "\s\t\n")
207 |       (let (title body)
208 |         (when (looking-at "^#*[\s\t]*")
209 |           (goto-char (match-end 0)))
210 |         (setq title (magit--buffer-string (point) (line-end-position) t))
211 |         (forward-line)
212 |         (setq body (magit--buffer-string (point) nil ?\n))
213 |         (cons (string-trim title)
214 |               (string-trim body))))))
215 | 
216 | (defun forge--post-submit-callback ()
217 |   (let* ((file    buffer-file-name)
218 |          (editbuf (current-buffer))
219 |          (prevbuf forge--pre-post-buffer)
220 |          (topic   (ignore-errors (forge-get-topic forge--buffer-post-object)))
221 |          (repo    (forge-get-repository topic)))
222 |     (lambda (value &optional headers status req)
223 |       (run-hook-with-args 'forge-post-submit-callback-hook
224 |                           value headers status req)
225 |       (delete-file file t)
226 |       (let ((dir (file-name-directory file)))
227 |         (unless (cddr (directory-files dir nil nil t))
228 |           (delete-directory dir nil t)))
229 |       (when (buffer-live-p editbuf)
230 |         (with-current-buffer editbuf
231 |           (magit-mode-bury-buffer 'kill)))
232 |       (with-current-buffer
233 |           (if (buffer-live-p prevbuf) prevbuf (current-buffer))
234 |         (if (and topic
235 |                  (forge--childp repo 'forge-github-repository)
236 |                  (oref repo selective-p))
237 |             (forge--pull-topic repo topic)
238 |           (forge-pull))))))
239 | 
240 | (defun forge--post-submit-errorback ()
241 |   (lambda (error &rest _)
242 |     (error "Failed to submit post: %S" error)))
243 | 
244 | ;;; Commands
245 | 
246 | (transient-define-prefix forge-post-menu ()
247 |   "Dispatch a post creation command."
248 |   [["Set"
249 |     :if (lambda ()
250 |           (and (forge-github-repository-p (forge-get-repository :tracked))
251 |                (string-prefix-p "new-"
252 |                                 (file-name-nondirectory buffer-file-name))))
253 |     ("-m" forge-new-topic-set-milestone)
254 |     ("-l" forge-new-topic-set-labels)
255 |     ("-a" forge-new-topic-set-assignees)
256 |     ("-d" forge-new-pullreq-toggle-draft)]
257 |    ["Actions"
258 |     ("C-c" "Submit" forge-post-submit)
259 |     ("C-k" "Cancel" forge-post-cancel)]])
260 | 
261 | (defun forge-post-submit ()
262 |   "Submit the post that is being edited in the current buffer."
263 |   (interactive)
264 |   (save-buffer)
265 |   (if-let ((fn forge--submit-post-function))
266 |       (funcall fn
267 |                (forge-get-repository forge--buffer-post-object)
268 |                forge--buffer-post-object)
269 |     (error "forge--submit-post-function is nil")))
270 | 
271 | (defun forge-post-cancel ()
272 |   "Cancel the post that is being edited in the current buffer."
273 |   (interactive)
274 |   (save-buffer)
275 |   (if-let ((fn forge--cancel-post-function))
276 |       (funcall fn forge--buffer-post-object)
277 |     (magit-mode-bury-buffer 'kill)))
278 | 
279 | (defclass forge--new-topic-set-slot-command (transient-lisp-variable)
280 |   ((name :initarg :name)
281 |    (reader :initarg :reader)
282 |    (formatter :initarg :formatter)
283 |    (format :initform " %k %d")
284 |    (description :initform (lambda (obj)
285 |                             (with-slots (name variable formatter) obj
286 |                               (if-let* ((value (symbol-value variable))
287 |                                         (value (funcall formatter value)))
288 |                                   (format "%s %s" name value)
289 |                                 (format "%s" name)))))))
290 | 
291 | (transient-define-infix forge-new-topic-set-milestone ()
292 |   "Set milestone for the topic being created."
293 |   :class 'forge--new-topic-set-slot-command
294 |   :variable 'forge--buffer-milestone
295 |   :name "milestone"
296 |   :reader (lambda (&rest _) (forge-read-topic-milestone))
297 |   :formatter (lambda (milestone) (propertize milestone 'face 'forge-topic-label))
298 |   :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue")))
299 | 
300 | (transient-define-infix forge-new-topic-set-labels ()
301 |   "Set labels for the topic being created."
302 |   :class 'forge--new-topic-set-slot-command
303 |   :variable 'forge--buffer-labels
304 |   :name "labels"
305 |   :reader (lambda (&rest _) (forge-read-topic-labels))
306 |   :formatter (##forge--format-labels % t)
307 |   :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue")))
308 | 
309 | (transient-define-infix forge-new-topic-set-assignees ()
310 |   "Set assignees for the pull-request being created."
311 |   :class 'forge--new-topic-set-slot-command
312 |   :variable 'forge--buffer-assignees
313 |   :name "assignees"
314 |   :reader (lambda (&rest _) (forge-read-topic-assignees))
315 |   :formatter #'forge--format-topic-assignees
316 |   :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue")))
317 | 
318 | (transient-define-infix forge-new-pullreq-toggle-draft ()
319 |   "Toggle whether the pull-request being created is a draft."
320 |   :class 'forge--new-topic-set-slot-command
321 |   :variable 'forge--buffer-draft-p
322 |   :name "draft"
323 |   :reader (lambda (&rest _) (not forge--buffer-draft-p))
324 |   :description (lambda ()
325 |                  (format (propertize "[%s]" 'face 'transient-delimiter)
326 |                          (propertize "draft" 'face
327 |                                      (if forge--buffer-draft-p
328 |                                          'transient-value
329 |                                        'transient-inactive-value))))
330 |   :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq")))
331 | 
332 | ;;; Notes
333 | 
334 | (defclass forge-note (forge-post) ())
335 | 
336 | (defvar-keymap forge-note-section-map
337 |   "<remap> <magit-edit-thing>" #'forge-edit-topic-note)
338 | 
339 | (defun forge--save-note (_repo topic)
340 |   (let ((value (string-trim (magit--buffer-string))))
341 |     (oset topic note (if (equal value "") nil value)))
342 |   (delete-file buffer-file-name t)
343 |   (let ((dir (file-name-directory buffer-file-name)))
344 |     (unless (cddr (directory-files dir nil nil t))
345 |       (delete-directory dir)))
346 |   (let ((prevbuf forge--pre-post-buffer))
347 |     (magit-mode-bury-buffer 'kill)
348 |     (forge-refresh-buffer prevbuf)))
349 | 
350 | ;;; _
351 | ;; Local Variables:
352 | ;; read-symbol-shorthands: (
353 | ;;   ("partial" . "llama--left-apply-partially")
354 | ;;   ("rpartial" . "llama--right-apply-partially"))
355 | ;; End:
356 | (provide 'forge-post)
357 | ;;; forge-post.el ends here
358 | 


--------------------------------------------------------------------------------
/lisp/forge-pullreq.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-pullreq.el --- Pullreq support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'forge)
 26 | (require 'forge-post)
 27 | (require 'forge-topic)
 28 | 
 29 | ;;; Classes
 30 | 
 31 | (defclass forge-pullreq (forge-topic)
 32 |   ((closql-table         :initform 'pullreq)
 33 |    (closql-primary-key   :initform 'id)
 34 |    (closql-order-by      :initform [(desc number)])
 35 |    (closql-foreign-key   :initform 'repository)
 36 |    (closql-class-prefix  :initform "forge-")
 37 |    (id                   :initarg :id)
 38 |    (repository           :initarg :repository)
 39 |    (number               :initarg :number)
 40 |    (state                :initarg :state)
 41 |    (author               :initarg :author)
 42 |    (title                :initarg :title)
 43 |    (created              :initarg :created)
 44 |    (updated              :initarg :updated :initform nil)
 45 |    (closed               :initarg :closed)
 46 |    (merged               :initarg :merged)
 47 |    (status               :initarg :status :initform nil)
 48 |    (locked-p             :initarg :locked-p)
 49 |    (editable-p           :initarg :editable-p)
 50 |    (cross-repo-p         :initarg :cross-repo-p)
 51 |    (base-ref             :initarg :base-ref)
 52 |    (base-repo            :initarg :base-repo)
 53 |    (head-ref             :initarg :head-ref)
 54 |    (head-user            :initarg :head-user)
 55 |    (head-repo            :initarg :head-repo)
 56 |    (milestone            :initarg :milestone)
 57 |    (body                 :initarg :body)
 58 |    (assignees            :closql-tables (pullreq-assignee assignee))
 59 |    (project-cards) ; projectsCards
 60 |    (commits)
 61 |    (edits) ; userContentEdits
 62 |    (labels               :closql-tables (pullreq-label label))
 63 |    (participants)
 64 |    (posts                :closql-class forge-pullreq-post)
 65 |    (reactions)
 66 |    (review-requests      :closql-tables (pullreq-review-request assignee))
 67 |    (reviews)
 68 |    (timeline)
 69 |    (marks                :closql-tables (pullreq-mark mark))
 70 |    (note                 :initarg :note :initform nil)
 71 |    (base-rev             :initarg :base-rev)
 72 |    (head-rev             :initarg :head-rev)
 73 |    (draft-p              :initarg :draft-p)
 74 |    (their-id             :initarg :their-id)
 75 |    (slug                 :initarg :slug)
 76 |    (saved-p              :initarg :saved-p :initform nil)
 77 |    ))
 78 | 
 79 | (cl-defmethod closql-dref ((obj forge-pullreq) (_(eql assignees)))
 80 |   (forge-sql-cdr
 81 |    [:select assignee:* :from assignee
 82 |     :join pullreq-assignee :on (= pullreq-assignee:id assignee:id)
 83 |     :where (= pullreq-assignee:pullreq $s1)
 84 |     :order-by [(asc login)]]
 85 |    (closql--oref obj 'id)))
 86 | 
 87 | (cl-defmethod closql-dref ((obj forge-pullreq) (_(eql labels)))
 88 |   (forge-sql-cdr
 89 |    [:select label:* :from label
 90 |     :join pullreq-label :on (= pullreq-label:id label:id)
 91 |     :where (= pullreq-label:pullreq $s1)
 92 |     :order-by [(asc name)]]
 93 |    (closql--oref obj 'id)))
 94 | 
 95 | (cl-defmethod closql-dref ((obj forge-pullreq) (_(eql review-requests)))
 96 |   (forge-sql-cdr
 97 |    [:select assignee:* :from assignee
 98 |     :join pullreq-review-request :on (= pullreq-review-request:id assignee:id)
 99 |     :where (= pullreq-review-request:pullreq $s1)
100 |     :order-by [(asc login)]]
101 |    (closql--oref obj 'id)))
102 | 
103 | (cl-defmethod closql-dref ((obj forge-pullreq) (_(eql marks)))
104 |   (forge-sql-cdr
105 |    [:select mark:* :from mark
106 |     :join pullreq-mark :on (= pullreq-mark:id mark:id)
107 |     :where (= pullreq-mark:pullreq $s1)
108 |     :order-by [(asc name)]]
109 |    (closql--oref obj 'id)))
110 | 
111 | (defclass forge-pullreq-post (forge-post)
112 |   ((closql-table         :initform 'pullreq-post)
113 |    (closql-primary-key   :initform 'id)
114 |    (closql-order-by      :initform [(asc number)])
115 |    (closql-foreign-key   :initform 'pullreq)
116 |    (closql-class-prefix  :initform "forge-pullreq-")
117 |    (id                   :initarg :id)
118 |    (pullreq              :initarg :pullreq)
119 |    (number               :initarg :number)
120 |    (author               :initarg :author)
121 |    (created              :initarg :created)
122 |    (updated              :initarg :updated)
123 |    (body                 :initarg :body)
124 |    (edits)
125 |    (reactions)
126 |    ))
127 | 
128 | ;;; Query
129 | ;;;; Get
130 | 
131 | (cl-defmethod forge-get-repository ((post forge-pullreq-post))
132 |   (forge-get-repository (forge-get-pullreq post)))
133 | 
134 | (cl-defmethod forge-get-topic ((post forge-pullreq-post))
135 |   (forge-get-pullreq post))
136 | 
137 | (cl-defmethod forge-get-pullreq ((pullreq forge-pullreq))
138 |   pullreq)
139 | 
140 | (cl-defmethod forge-get-pullreq ((repo forge-repository) number)
141 |   (closql-get (forge-db)
142 |               (forge--object-id 'forge-pullreq repo number)
143 |               'forge-pullreq))
144 | 
145 | (cl-defmethod forge-get-pullreq ((number integer))
146 |   (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
147 |     (forge-get-pullreq repo number)))
148 | 
149 | (cl-defmethod forge-get-pullreq ((id string))
150 |   (closql-get (forge-db) id 'forge-pullreq))
151 | 
152 | (cl-defmethod forge-get-pullreq ((post forge-pullreq-post))
153 |   (closql-get (forge-db)
154 |               (oref post pullreq)
155 |               'forge-pullreq))
156 | 
157 | (cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch)
158 |   (and-let* ((branch (or branch
159 |                          (magit-section-case
160 |                            (branch (oref it value))
161 |                            (commit (magit--painted-branch-at-point)))))
162 |              (branch (cdr (magit-split-branch-name branch)))
163 |              (number (magit-get "branch" branch "pullRequest")))
164 |     (forge-get-pullreq (string-to-number number))))
165 | 
166 | ;;;; Current
167 | 
168 | (defun forge-current-pullreq (&optional demand)
169 |   "Return the pull-request at point or being visited.
170 | If there is no such pull-request and DEMAND is non-nil, then signal
171 | an error."
172 |   (or (forge-pullreq-at-point)
173 |       (and (forge-pullreq-p forge-buffer-topic)
174 |            forge-buffer-topic)
175 |       (and demand (user-error "No current pull-request"))))
176 | 
177 | (defun forge-pullreq-at-point (&optional demand)
178 |   "Return the pull-request at point.
179 | If there is no such pull-request and DEMAND is non-nil, then signal
180 | an error."
181 |   (or (thing-at-point 'forge-pullreq)
182 |       (magit-section-value-if 'pullreq)
183 |       (forge-get-pullreq :branch)
184 |       (and demand (user-error "No pull-request at point"))))
185 | 
186 | (put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq)
187 | (defun forge-thingatpt--pullreq ()
188 |   (and-let* (((thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>"))
189 |              (prefix (match-string-no-properties 1))
190 |              (number (string-to-number (match-string-no-properties 2)))
191 |              (repo (forge--repo-for-thingatpt))
192 |              ((or (equal prefix "#")
193 |                   (forge-gitlab-repository--eieio-childp repo))))
194 |     (forge-get-pullreq repo number)))
195 | 
196 | ;;; Read
197 | 
198 | (defun forge-read-pullreq (prompt)
199 |   "Read an active pull-request with completion using PROMPT.
200 | 
201 | Open, unread and pending pull-requests are considered active.
202 | Default to the current pull-request, even if it isn't active.
203 | 
204 | \\<forge-read-topic-minibuffer-map>While completion is in \
205 | progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
206 | the completion candidates to include all pull-requests.
207 | 
208 | If `forge-limit-topic-choices' is nil, then all candidates
209 | can be selected from the start."
210 |   (forge--read-topic prompt
211 |                      #'forge-current-pullreq
212 |                      (forge--topics-spec :type 'pullreq :active t)
213 |                      (forge--topics-spec :type 'pullreq :active nil :state nil)))
214 | 
215 | ;;; Utilities
216 | 
217 | (defun forge--pullreq-branch-internal (pullreq)
218 |   (let ((branch (oref pullreq head-ref)))
219 |     ;; It is invalid for a branch name to begin with a colon, yet
220 |     ;; that is what Gitlab uses when a pull-request's source branch
221 |     ;; has been deleted.  On Github this is simply nil in the same
222 |     ;; situation.
223 |     (and branch (not (string-prefix-p ":" branch)) branch)))
224 | 
225 | (defun forge--pullreq-branch-active (pullreq)
226 |   (let* ((number (number-to-string (oref pullreq number)))
227 |          (branch-n (format "pr-%s" number))
228 |          (branch (forge--pullreq-branch-internal pullreq)))
229 |     (or (and (magit-branch-p branch)
230 |              (equal (magit-get "branch" branch "pullRequest") number)
231 |              branch)
232 |         (and (magit-branch-p branch-n)
233 |              (equal (magit-get "branch" branch-n "pullRequest") number)
234 |              branch-n))))
235 | 
236 | (defun forge--pullreq-ref (pullreq)
237 |   (let ((ref (format "refs/pullreqs/%s" (oref pullreq number))))
238 |     (and (magit-rev-verify ref) ref)))
239 | 
240 | (defun forge--pullreq-range (pullreq &optional endpoints)
241 |   (and-let* ((head (forge--pullreq-ref pullreq)))
242 |     (concat (forge--get-remote) "/" (oref pullreq base-ref)
243 |             (if endpoints "..." "..")
244 |             head)))
245 | 
246 | ;;; Insert
247 | 
248 | (defvar-keymap forge-pullreqs-section-map
249 |   :parent forge-common-map
250 |   "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
251 |   "<remap> <magit-visit-thing>"  #'forge-list-pullreqs
252 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
253 |   "<remap> <forge--item-menu>"   #'forge-topic-menu
254 |   "C-c C-n"                      #'forge-create-pullreq)
255 | 
256 | (defvar-keymap forge-pullreq-section-map
257 |   :parent forge-common-map
258 |   "<remap> <magit-visit-thing>"  #'forge-visit-this-topic
259 |   "<remap> <forge--list-menu>"   #'forge-topics-menu
260 |   "<remap> <forge--item-menu>"   #'forge-topic-menu)
261 | 
262 | (cl-defun forge-insert-pullreqs (&optional (spec nil sspec) heading)
263 |   "Insert a list of pull-requests, according to `forge--buffer-topics-spec'.
264 | Optional SPEC can be used to override that filtering specification,
265 | and optional HEADING to change the section heading."
266 |   (when-let (((forge-db t))
267 |              (repo (forge-get-repository :tracked?))
268 |              (spec (if sspec spec (forge--clone-buffer-topics-spec)))
269 |              ((memq (oref spec type) '(topic pullreq))))
270 |     (oset spec type 'pullreq)
271 |     (forge--insert-topics 'pullreqs
272 |                           (or heading "Pull requests")
273 |                           (forge--list-topics spec repo))))
274 | 
275 | (defun forge--insert-pullreq-commits (pullreq &optional all)
276 |   (cl-letf (((symbol-function #'magit-cancel-section) (lambda ())))
277 |     (if all
278 |         ;; Numeric pr ref, pr branch (if it exists) and api
279 |         ;; pr range may be out of sync.  Just show them all.
280 |         (magit-insert-section-body
281 |           (magit--insert-log nil
282 |             (delq nil (list (concat "^" (or (oref pullreq base-rev)
283 |                                             (concat (forge--get-remote) "/"
284 |                                                     (oref pullreq base-ref))))
285 |                             (forge--pullreq-ref pullreq)
286 |                             (forge--pullreq-branch-active pullreq)
287 |                             (and-let* ((branch (oref pullreq head-ref)))
288 |                               (and (magit-local-branch-p branch) branch))))
289 |             (seq-uniq (cons "--graph" magit-buffer-log-args))))
290 |       (when-let ((range (forge--pullreq-range pullreq)))
291 |         (magit-insert-section-body
292 |           (magit--insert-log nil range magit-buffer-log-args)
293 |           (magit-make-margin-overlay nil t))))))
294 | 
295 | ;;; _
296 | ;; Local Variables:
297 | ;; read-symbol-shorthands: (
298 | ;;   ("partial" . "llama--left-apply-partially")
299 | ;;   ("rpartial" . "llama--right-apply-partially"))
300 | ;; End:
301 | (provide 'forge-pullreq)
302 | ;;; forge-pullreq.el ends here
303 | 


--------------------------------------------------------------------------------
/lisp/forge-repo.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-repo.el --- Repository support  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'forge)
 26 | (require 'eieio)
 27 | 
 28 | ;;; Classes
 29 | 
 30 | (defclass forge-repository (forge-object)
 31 |   ((closql-class-prefix        :initform "forge-")
 32 |    (closql-class-suffix        :initform "-repository")
 33 |    (closql-table               :initform 'repository)
 34 |    (closql-primary-key         :initform 'id)
 35 |    (discussions-url-format     :initform nil :allocation :class)
 36 |    (discussion-url-format      :initform nil :allocation :class)
 37 |    (discussion-post-url-format :initform nil :allocation :class)
 38 |    (issues-url-format          :initform nil :allocation :class)
 39 |    (issue-url-format           :initform nil :allocation :class)
 40 |    (issue-post-url-format      :initform nil :allocation :class)
 41 |    (pullreqs-url-format        :initform nil :allocation :class)
 42 |    (pullreq-url-format         :initform nil :allocation :class)
 43 |    (pullreq-post-url-format    :initform nil :allocation :class)
 44 |    (commit-url-format          :initform nil :allocation :class)
 45 |    (branch-url-format          :initform nil :allocation :class)
 46 |    (remote-url-format          :initform nil :allocation :class)
 47 |    (blob-url-format            :initform nil :allocation :class)
 48 |    (create-issue-url-format    :initform nil :allocation :class)
 49 |    (create-pullreq-url-format  :initform nil :allocation :class)
 50 |    (pullreq-refspec            :initform nil :allocation :class)
 51 |    (id                         :initform nil :initarg :id)
 52 |    (forge-id                   :initform nil :initarg :forge-id)
 53 |    (forge                      :initform nil :initarg :forge)
 54 |    (owner                      :initform nil :initarg :owner)
 55 |    (name                       :initform nil :initarg :name)
 56 |    (apihost                    :initform nil :initarg :apihost)
 57 |    (githost                    :initform nil :initarg :githost)
 58 |    (remote                     :initform nil :initarg :remote)
 59 |    (condition                  :initform :stub)
 60 |    (created                    :initform nil)
 61 |    (updated                    :initform nil)
 62 |    (pushed                     :initform nil)
 63 |    (parent                     :initform nil)
 64 |    (description                :initform nil)
 65 |    (homepage                   :initform nil)
 66 |    (default-branch             :initform nil)
 67 |    (archived-p                 :initform nil)
 68 |    (fork-p                     :initform nil)
 69 |    (locked-p                   :initform nil)
 70 |    (mirror-p                   :initform nil)
 71 |    (private-p                  :initform nil)
 72 |    (issues-p                   :initform t)
 73 |    (wiki-p                     :initform nil)
 74 |    (stars                      :initform nil)
 75 |    (watchers                   :initform nil)
 76 |    (assignees                  :closql-table assignee)
 77 |    (forks                      :closql-table fork)
 78 |    (issues                     :closql-class forge-issue)
 79 |    (labels                     :closql-table label)
 80 |    (pullreqs                   :closql-class forge-pullreq)
 81 |    (revnotes                   :closql-class forge-revnote)
 82 |    (selective-p                :initform nil)
 83 |    (worktree                   :initform nil)
 84 |    (milestones                 :closql-table milestone)
 85 |    (issues-until               :initform nil)
 86 |    (pullreqs-until             :initform nil)
 87 |    (teams                      :initform nil)
 88 |    (discussion-categories      :closql-table discussion-category)
 89 |    (discussions                :closql-class forge-discussion)
 90 |    (discussions-p              :initform nil)
 91 |    (discussions-until          :initform nil))
 92 |   :abstract t)
 93 | 
 94 | (defclass forge-unusedapi-repository (forge-repository) () :abstract t)
 95 | 
 96 | (defclass forge-noapi-repository (forge-repository) () :abstract t)
 97 | 
 98 | (cl-defmethod slot-missing ((object forge-repository)
 99 |                             slot-name operation &optional _new-value)
100 |   (if (and (eq operation 'oref)
101 |            (eq slot-name 'slug))
102 |       (concat (oref object owner) "/"
103 |               (oref object name))
104 |     (cl-call-next-method)))
105 | 
106 | ;;; Query
107 | ;;;; Get
108 | 
109 | (defvar-local forge-buffer-repository nil)
110 | (put 'forge-buffer-repository 'permanent-local t)
111 | 
112 | (defvar-local forge-buffer-unassociated-p nil)
113 | 
114 | (defconst forge--signal-no-entry '(:tracked :stub :insert!))
115 | 
116 | (defun forge--get-remote (&optional warn ignore-variable)
117 |   (let* ((remotes (magit-list-remotes))
118 |          (config (and (not ignore-variable)
119 |                       (magit-get "forge.remote")))
120 |          (remote (if (cdr remotes)
121 |                      (or (car (member config remotes))
122 |                          (car (member "upstream" remotes))
123 |                          (car (member "origin" remotes)))
124 |                    (car remotes))))
125 |     (when (and warn config remote (not (equal config remote)))
126 |       (message "Ignored forge.remote=%s; no such remote.\nSee %s." config
127 |                "https://magit.vc/manual/forge/How-Forge-Detection-Works.html"))
128 |     remote))
129 | 
130 | (cl-defmethod forge-get-repository ((_(eql :id)) id)
131 |   (closql-get (forge-db) (substring-no-properties id) 'forge-repository))
132 | 
133 | (cl-defmethod forge-get-repository ((_(eql :dir)) dir)
134 |   (let ((default-directory dir)
135 |         (forge-buffer-repository nil)
136 |         (forge-buffer-topic nil))
137 |     (forge-get-repository :stub? nil 'notatpt)))
138 | 
139 | (cl-defmethod forge-get-repository ((demand symbol) &optional remote notatpt)
140 |   "Return the current forge repository.
141 | 
142 | First check if `forge-buffer-repository', or if that is nil, then
143 | the repository for `forge-buffer-topic', satisfies DEMAND.  If so,
144 | then return that repository.
145 | 
146 | Otherwise return the repository for `default-directory', if that
147 | exists and satisfies DEMAND.  If that fails too, then return nil
148 | or signal an error, depending on DEMAND."
149 |   (or (and-let* (((not notatpt))
150 |                  (repo (forge-repository-at-point)))
151 |         (forge-get-repository repo 'noerror demand))
152 |       (and-let* (((not remote))
153 |                  (repo (or (forge-buffer-repository)
154 |                            (and forge-buffer-topic
155 |                                 (forge-get-repository forge-buffer-topic)))))
156 |         (forge-get-repository repo 'noerror demand))
157 |       (magit--with-refresh-cache
158 |           (list default-directory 'forge-get-repository demand)
159 |         (if (not (magit-gitdir))
160 |             (when (memq demand forge--signal-no-entry)
161 |               (error
162 |                "Cannot determine Forge repository outside of Git repository"))
163 |           (unless remote
164 |             (setq remote (forge--get-remote 'warn)))
165 |           (if-let ((url (and remote
166 |                              (magit-git-string "remote" "get-url" remote))))
167 |               (and-let* ((repo (forge-get-repository url remote demand)))
168 |                 (progn ; work around debbugs#31840
169 |                   (oset repo worktree (magit-toplevel))
170 |                   repo))
171 |             (when (memq demand forge--signal-no-entry)
172 |               (error
173 |                "Cannot determine forge repository.  %s\nSee %s."
174 |                (cond (remote (format "No url configured for %S." remote))
175 |                      ((and-let* ((config (magit-get "forge.remote")))
176 |                         (format "Value of `forge.remote' is %S but %s"
177 |                                 config "that remote does not exist.")))
178 |                      ((magit-list-remotes) "Cannot decide on remote to use.")
179 |                      (t "No remote configured."))
180 |                "https://magit.vc/manual/forge/How-Forge-Detection-Works.html"
181 |                )))))))
182 | 
183 | (cl-defmethod forge-get-repository ((url string) &optional remote demand)
184 |   "Return the repository at URL."
185 |   (if-let ((parts (forge--split-forge-url url)))
186 |       (forge-get-repository parts remote (or demand :known?))
187 |     (when (memq demand forge--signal-no-entry)
188 |       (error "Cannot determine forge repository.  %s isn't a forge URL.  %s"
189 |              url "You might have to customize `forge-alist'."))))
190 | 
191 | (cl-defmethod forge-get-repository (((host owner name) list)
192 |                                     &optional remote demand)
193 |   "((HOST OWNER NAME) &optional REMOTE DEMAND)
194 | 
195 | Return the repository identified by HOST, OWNER and NAME.
196 | See `forge-alist' for valid Git hosts."
197 |   (setq host  (substring-no-properties host))
198 |   (setq owner (substring-no-properties owner))
199 |   (setq name  (substring-no-properties name))
200 |   (unless (memq demand '( :tracked :tracked?
201 |                           :known? :insert! :valid?
202 |                           :stub :stub?))
203 |     (if-let ((new (pcase demand
204 |                     ('t      :tracked)
205 |                     ('full   :tracked?)
206 |                     ('nil    :known?)
207 |                     ('create :insert!)
208 |                     ('stub   :stub)
209 |                     ('maybe  :stub?))))
210 |         (progn
211 |           (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead"
212 |                    'forge-get-repository demand new)
213 |           (setq demand new))
214 |       (error "Unknown value for `%s's DEMAND: `%s'"
215 |              'forge-get-repository demand)))
216 |   (if-let ((spec (forge--get-forge-host host t)))
217 |       (pcase-let ((`(,githost ,apihost ,webhost ,class) spec))
218 |         ;; The `webhost' is used to identify the corresponding forge.
219 |         ;; For that reason it is stored in the `forge' slot.  The id
220 |         ;; stored in the `id' slot also derives from that value.
221 |         (let* ((row (car (forge-sql [:select * :from repository
222 |                                      :where (and (= forge $s1)
223 |                                                  (= owner $s2)
224 |                                                  (= name  $s3))]
225 |                                     webhost owner name)))
226 |                (obj (and row (closql--remake-instance class (forge-db) row))))
227 |           ;; Synchronize the object with the entry from `forge-alist'.
228 |           ;; This only has an effect if the entry was modified, which
229 |           ;; should rarely, if ever, happen.  Avoid confusion, by not
230 |           ;; mentioning this detail in any docstring.
231 |           (when obj
232 |             (oset obj apihost apihost)
233 |             (oset obj githost githost)
234 |             (oset obj remote  remote))
235 |           (pcase (list demand (and obj (eq (oref obj condition) :tracked)))
236 |             (`(:tracked? nil) (setq obj nil))
237 |             (`(:tracked  nil)
238 |              (error "Cannot use `%s' in %S yet.\n%s"
239 |                     this-command (magit-toplevel)
240 |                     "Use `M-x forge-add-repository' before trying again.")))
241 |           (when (and (memq demand '(:insert! :valid? :stub :stub?))
242 |                      (not obj))
243 |             (pcase-let ((`(,id . ,forge-id)
244 |                          (forge--repository-ids
245 |                           class webhost owner name
246 |                           (memq demand '(:stub :stub?))
247 |                           (eq demand :valid?))))
248 |               (if (not id)
249 |                   ;; `:valid?' was used and it turned out it is not.
250 |                   (setq obj nil)
251 |                 ;; The repo might have been renamed on the forge.  #188
252 |                 (unless (setq obj (forge-get-repository :id id))
253 |                   (setq obj (funcall class
254 |                                      :id       id
255 |                                      :forge-id forge-id
256 |                                      :forge    webhost
257 |                                      :owner    owner
258 |                                      :name     name
259 |                                      :apihost  apihost
260 |                                      :githost  githost
261 |                                      :remote   remote))
262 |                   (when (eq demand :insert!)
263 |                     (closql-insert (forge-db) obj)
264 |                     (oset obj condition :known))))))
265 |           obj))
266 |     (when (memq demand forge--signal-no-entry)
267 |       (error "Cannot determine forge repository.  No entry for %S in %s"
268 |              host 'forge-alist))))
269 | 
270 | (cl-defmethod forge-get-repository ((repo forge-repository)
271 |                                     &optional noerror demand)
272 |   (setq noerror (and noerror t))
273 |   (with-slots (condition slug) repo
274 |     (cl-symbol-macrolet
275 |         ((err (error "Requested %s for %s, but is %s" demand slug condition))
276 |          (key (list (oref repo forge)
277 |                     (oref repo owner)
278 |                     (oref repo name)))
279 |          (ins (forge-get-repository key nil :insert!))
280 |          (set (forge-get-repository key nil :valid?)))
281 |       (pcase-exhaustive (list demand condition noerror)
282 |         (`(nil       ,_                     ,_)  repo)
283 |         (`(:tracked? :tracked               ,_)  repo)
284 |         (`(:tracked? ,_                     ,_)   nil)
285 |         (`(:tracked  :tracked               ,_)  repo)
286 |         (`(:tracked  ,_                      t)   nil)
287 |         (`(:tracked  ,_                    nil)   err)
288 |         (`(:known?   ,(or :tracked :known)  ,_)  repo)
289 |         (`(:known?   ,_                     ,_)   nil)
290 |         (`(:insert!  ,(or :tracked :known)  ,_)  repo)
291 |         (`(:insert!  ,_                     ,_)   ins)
292 |         (`(:valid?   ,(or :tracked :known)  ,_)  repo)
293 |         (`(:valid?   ,_                     ,_)   set)
294 |         (`(:stub?    ,_                     ,_)  repo)
295 |         (`(:stub     ,_                     ,_)  repo)))))
296 | 
297 | (cl-defmethod forge-get-repository ((_ null) &optional noerror demand)
298 |   (if (and (memq demand '(:insert! :tracked :stub))
299 |            (not noerror))
300 |       (error "(Maybe repository) is nil; `%s' not satisfied" demand)
301 |     nil))
302 | 
303 | (defun forge-repository-at-point (&optional demand)
304 |   "Return the repository at point.
305 | If there is no such repository and DEMAND is non-nil, then signal
306 | an error."
307 |   (or (magit-section-value-if 'forge-repo)
308 |       (and-let* ((topic (forge-topic-at-point)))
309 |         (forge-get-repository topic))
310 |       (and (derived-mode-p 'forge-repository-list-mode)
311 |            (and-let* ((id (tabulated-list-get-id)))
312 |              (forge-get-repository :id id)))
313 |       (and (derived-mode-p 'magit-repolist-mode)
314 |            (and-let* ((dir (tabulated-list-get-id)))
315 |              (forge-get-repository :dir dir)))
316 |       (and demand (user-error "No repository at point"))))
317 | 
318 | (defun forge--repo-for-thingatpt ()
319 |   (or (magit-section-value-if 'forge-repo)
320 |       (and-let* ((topic (magit-section-value-if '(issue pullreq))))
321 |         (forge-get-repository topic))
322 |       (and (not forge-buffer-unassociated-p)
323 |            (or (forge-buffer-repository)
324 |                (forge-get-repository :known? nil 'notatpt)))))
325 | 
326 | (defun forge-buffer-repository ()
327 |   (and-let* ((id forge-buffer-repository))
328 |     (forge-get-repository :id id)))
329 | 
330 | (defun forge-set-buffer-repository ()
331 |   "Initialize the value of variable `forge-buffer-repository'."
332 |   (unless forge-buffer-repository
333 |     (and-let* ((repo (forge-get-repository :known?)))
334 |       (setq forge-buffer-repository (oref repo id)))))
335 | 
336 | (add-hook 'magit-mode-hook #'forge-set-buffer-repository)
337 | 
338 | (defun forge-get-worktree (repo)
339 |   "Validate, remember and return a worktree for REPO.
340 | If `default-directory' is within one of REPO's worktrees, record that
341 | location in its `worktree' slot and return it.  Otherwise, if a worktree
342 | has been recorded before, validate that.  If it still is a worktree of
343 | REPO, return it, else set the slot to nil and return nil."
344 |   (if-let (((forge-repository-equal
345 |              repo (forge-get-repository :dir default-directory)))
346 |            (current-tree (magit-toplevel)))
347 |       (oset repo worktree current-tree)
348 |     (and-let* ((saved-tree (oref repo worktree)))
349 |       (and (file-accessible-directory-p saved-tree)
350 |            (if (forge-repository-equal
351 |                 repo (forge-get-repository :dir saved-tree))
352 |                saved-tree
353 |              (oset repo worktree nil))))))
354 | 
355 | ;;;; List
356 | 
357 | (defun forge--ls-repos ()
358 |   (mapcar (partial #'closql--remake-instance 'forge-repository (forge-db))
359 |           (forge-sql [:select * :from repository
360 |                       :order-by [(asc owner) (asc name)]])))
361 | 
362 | (defun forge--ls-owned-repos ()
363 |   (mapcar (partial #'closql--remake-instance 'forge-repository (forge-db))
364 |           (forge-sql [:select * :from repository
365 |                       :where (and (in owner $v1)
366 |                                   (not (in name $v2)))
367 |                       :order-by [(asc owner) (asc name)]]
368 |                      (vconcat (mapcar #'car forge-owned-accounts))
369 |                      (vconcat forge-owned-ignored))))
370 | 
371 | ;;; Identity
372 | 
373 | (defun forge-repository-equal (repo1 repo2)
374 |   "Return t if REPO1 and REPO2 are the same repository.
375 | REPO1 and/or REPO2 may also be nil, in which case return nil."
376 |   (and repo1 repo2
377 |        (or (equal      (oref repo1 id)      (oref repo2 id))
378 |            (and (equal (oref repo1 githost) (oref repo2 githost))
379 |                 (equal (oref repo1 owner)   (oref repo2 owner))
380 |                 (equal (oref repo1 name)    (oref repo2 name))))))
381 | 
382 | (cl-defmethod forge--repository-ids ((class (subclass forge-repository))
383 |                                      host owner name &optional stub noerror)
384 |   "Return (OUR-ID . THEIR-ID) of the specified repository.
385 | If optional STUB is non-nil, then the IDs are not guaranteed to
386 | be unique.  Otherwise this method has to make an API request to
387 | retrieve THEIR-ID, the repository's ID on the forge.  In that
388 | case OUR-ID derives from THEIR-ID and is unique across all
389 | forges and hosts."
390 |   (pcase-let* ((`(,_githost ,apihost ,id ,_class)
391 |                 (forge--get-forge-host host t))
392 |                (path (format "%s/%s" owner name))
393 |                (their-id (and (not stub)
394 |                               (ghub-repository-id
395 |                                owner name
396 |                                :host apihost
397 |                                :auth 'forge
398 |                                :forge (forge--ghub-type-symbol class)
399 |                                :noerror noerror))))
400 |     (and (or stub their-id (not noerror))
401 |          (cons (base64-encode-string
402 |                 (format "%s:%s" id
403 |                         (cond (stub path)
404 |                               ((eq class 'forge-github-repository)
405 |                                ;; This is base64 encoded, according to
406 |                                ;; https://docs.github.com/en/graphql/
407 |                                ;; reference/scalars#id.  Unfortunately
408 |                                ;; that is not always true.  E.g.,
409 |                                ;; https://github.com/dit7ya/roamex.
410 |                                (condition-case nil
411 |                                    (base64-decode-string their-id)
412 |                                  (error their-id)))
413 |                               (t their-id)))
414 |                 t)
415 |                (or their-id path)))))
416 | 
417 | (cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository))
418 |                                      host owner name &optional _stub _noerror)
419 |   (let ((their-id (if owner (concat owner "/" name) name)))
420 |     (cons (base64-encode-string
421 |            (format "%s:%s"
422 |                    (nth 3 (forge--get-forge-host host t))
423 |                    their-id)
424 |            t)
425 |           their-id)))
426 | 
427 | ;;; Read
428 | 
429 | (defun forge-read-repository (prompt)
430 |   (let ((choice (magit-completing-read
431 |                  prompt
432 |                  (mapcar (pcase-lambda (`(,host ,owner ,name))
433 |                            (format "%s/%s @%s" owner name host))
434 |                          (forge-sql [:select [githost owner name]
435 |                                      :from repository]))
436 |                  nil t nil nil
437 |                  (and-let* ((default (forge-get-repository :stub?)))
438 |                    (format "%s/%s @%s"
439 |                            (oref default owner)
440 |                            (oref default name)
441 |                            (oref default githost))))))
442 |     (save-match-data
443 |       (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
444 |           (forge-get-repository (list (match-string 3 choice)
445 |                                       (match-string 1 choice)
446 |                                       (match-string 2 choice)))
447 |         (error "BUG")))))
448 | 
449 | (defun forge-read-host (prompt &optional class)
450 |   (magit-completing-read
451 |    prompt
452 |    (if class
453 |        (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c))
454 |                    (and (child-of-class-p c class) githost))
455 |                  forge-alist)
456 |      (mapcar #'car forge-alist))
457 |    nil t))
458 | 
459 | ;;; Miscellaneous
460 | 
461 | (defun forge--as-githost (host)
462 |   (or (car (car (cl-member host forge-alist :test #'equal :key #'car)))
463 |       (car (car (cl-member host forge-alist :test #'equal :key #'cadr)))
464 |       (car (car (cl-member host forge-alist :test #'equal :key #'caddr)))
465 |       (user-error "Cannot determine githost for %S" host)))
466 | 
467 | (defun forge--as-apihost (host)
468 |   (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr)))
469 |       (cadr (car (cl-member host forge-alist :test #'equal :key #'car)))
470 |       (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr)))
471 |       (user-error "Cannot determine apihost for %S" host)))
472 | 
473 | (cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
474 |   (pcase-let* (((eieio (forge webhost) owner name) repo)
475 |                (path (if owner (concat owner "/" name) name)))
476 |     (format-spec
477 |      (let ((format (if (symbolp format-or-slot)
478 |                        (eieio-oref repo format-or-slot)
479 |                      format-or-slot)))
480 |        (if (member webhost ghub-insecure-hosts)
481 |            (replace-regexp-in-string "\\`https://" "http://" format t t)
482 |          format))
483 |      `(,@spec
484 |        (?h . ,webhost)
485 |        (?o . ,owner)
486 |        (?n . ,name)
487 |        (?p . ,path)
488 |        (?P . ,(string-replace "/" "%2F" path))))))
489 | 
490 | (defun forge--set-field-callback (topic &optional preserve-status)
491 |   (let ((status (oref topic status)))
492 |     (lambda (&rest _)
493 |       (forge--pull-topic
494 |        (forge-get-repository topic)
495 |        topic
496 |        :callback (lambda ()
497 |                    ;; Necessary when setting a discussion field because
498 |                    ;; the API provides even less information about the
499 |                    ;; status of discussions compared to other topics and
500 |                    ;; as a result we would otherwise always switch the
501 |                    ;; status to `unread'.  This is not needed for every
502 |                    ;; modification of a discussion because some of them
503 |                    ;; (e.g., setting labels) do not cause `updated_at' to
504 |                    ;; be bumped; this second defect cancels out the first
505 |                    ;; when it comes to this function.
506 |                    (when preserve-status
507 |                      (oset topic status status))
508 |                    (forge-refresh-buffer)
509 |                    (when (transient-active-prefix
510 |                           '(forge-topic-menu
511 |                             forge-topics-menu
512 |                             forge-notifications-menu))
513 |                      (transient--refresh-transient)))))))
514 | 
515 | (defvar forge--mode-line-buffer nil)
516 | 
517 | (defun forge--msg (repo echo done format &rest args)
518 |   (let ((msg (apply #'format format args)))
519 |     (when repo
520 |       (setq msg (string-replace
521 |                  "REPO"
522 |                  (concat (oref repo owner) "/" (oref repo name))
523 |                  msg)))
524 |     (when (and echo msg)
525 |       (message "%s%s" msg (if done "...done" "...")))
526 |     (when (buffer-live-p forge--mode-line-buffer)
527 |       (with-current-buffer forge--mode-line-buffer
528 |         (setq mode-line-process
529 |               (if done
530 |                   nil
531 |                 (concat " " (propertize msg 'font-lock-face
532 |                                         'magit-mode-line-process)))))
533 |       (force-mode-line-update t))))
534 | 
535 | (cl-defmethod ghub--host ((repo forge-repository))
536 |   (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo))))
537 | 
538 | (cl-defmethod ghub--username ((repo forge-repository))
539 |   (let ((default-directory default-directory))
540 |     (unless (forge-repository-equal (forge-get-repository :stub?) repo)
541 |       (when-let ((worktree (forge-get-worktree repo)))
542 |         (setq default-directory worktree)))
543 |     (cl-call-next-method (oref repo apihost)
544 |                          (forge--ghub-type-symbol (eieio-object-class repo)))))
545 | 
546 | (defun forge--ghub-type-symbol (class)
547 |   (pcase-exhaustive class
548 |     ;; This package does not define a `forge-gitlab-http-repository'
549 |     ;; class, but we used to suggest at #9 that users define such a class
550 |     ;; if they must connect to a Gitlab instance that uses http instead
551 |     ;; of https.  Doing that isn't necessary anymore, but we have to keep
552 |     ;; supporting it here.  It is now sufficient to add an entry to
553 |     ;; `ghub-insecure-hosts'.
554 |     ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab)
555 |     ('forge-github-repository    'github)
556 |     ('forge-gitea-repository     'gitea)
557 |     ('forge-gogs-repository      'gogs)
558 |     ('forge-bitbucket-repository 'bitbucket)))
559 | 
560 | ;;; _
561 | ;; Local Variables:
562 | ;; read-symbol-shorthands: (
563 | ;;   ("partial" . "llama--left-apply-partially")
564 | ;;   ("rpartial" . "llama--right-apply-partially"))
565 | ;; End:
566 | (provide 'forge-repo)
567 | ;;; forge-repo.el ends here
568 | 


--------------------------------------------------------------------------------
/lisp/forge-repos.el:
--------------------------------------------------------------------------------
  1 | ;;; forge-repos.el --- List repositories  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | 
  8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
  9 | 
 10 | ;; This file is free software: you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published
 12 | ;; by the Free Software Foundation, either version 3 of the License,
 13 | ;; or (at your option) any later version.
 14 | ;;
 15 | ;; This file is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | ;;
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Code:
 24 | 
 25 | (require 'hl-line)
 26 | 
 27 | (require 'forge-repo)
 28 | (require 'forge-tablist)
 29 | 
 30 | (defvar x-stretch-cursor)
 31 | 
 32 | ;;; Options
 33 | 
 34 | (defcustom forge-repository-list-mode-hook '(hl-line-mode)
 35 |   "Hook run after entering Forge-Repository-List mode."
 36 |   :package-version '(forge . "0.4.0")
 37 |   :group 'forge
 38 |   :type 'hook
 39 |   :options '(hl-line-mode))
 40 | 
 41 | (defcustom forge-repository-list-columns
 42 |   '(("Owner"    owner                       20   t nil)
 43 |     ("Name"     name                        20   t nil)
 44 |     ("T"        forge-format-repo-condition  1   t nil)
 45 |     ("S"        forge-format-repo-selective  1   t nil)
 46 |     ("Worktree" worktree                    99   t nil))
 47 |   "List of columns displayed when listing repositories.
 48 | 
 49 | Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
 50 | 
 51 | HEADER is the string displayed in the header.  WIDTH is the width
 52 | of the column.  SOURCE is used to get the value, it has to be the
 53 | name of a slot of `forge-repository' or a function that takes
 54 | such an object as argument.  SORT is a boolean or a function used
 55 | to sort by this column.  Supported PROPS include `:right-align'
 56 | and `:pad-right'."
 57 |   :package-version '(forge . "0.4.0")
 58 |   :group 'forge
 59 |   :type forge--tablist-columns-type)
 60 | 
 61 | ;;; Mode
 62 | 
 63 | (defvar-keymap forge-repository-list-mode-map
 64 |   :doc "Local keymap for Forge-Repository-List mode buffers."
 65 |   :parent (make-composed-keymap forge-common-map tabulated-list-mode-map)
 66 |   "n"                          #'forge-dispatch
 67 |   "RET"                        #'forge-visit-this-repository
 68 |   "<return>"                   #'forge-visit-this-repository
 69 |   "o"                          #'forge-browse-this-repository
 70 |   "<remap> <forge--list-menu>" #'forge-repositories-menu)
 71 | 
 72 | (defvar-local forge--buffer-list-filter nil)
 73 | 
 74 | (defvar forge-repository-list-buffer-name "*forge-repositories*"
 75 |   "Buffer name to use for displaying lists of repositories.")
 76 | 
 77 | (defvar forge-repository-list-mode-name
 78 |   '((:eval (capitalize
 79 |             (concat (if forge--buffer-list-filter
 80 |                         (format "%s " forge--buffer-list-filter)
 81 |                       "")
 82 |                     "repositories"))))
 83 |   "Information shown in the mode-line for `forge-repository-list-mode'.
 84 | Must be set before `forge-list' is loaded.")
 85 | 
 86 | (define-derived-mode forge-repository-list-mode tabulated-list-mode
 87 |   forge-repository-list-mode-name
 88 |   "Major mode for browsing a list of repositories."
 89 |   :interactive nil
 90 |   (setq-local x-stretch-cursor nil)
 91 |   (setq tabulated-list-padding 0)
 92 |   (setq tabulated-list-sort-key (cons "Owner" nil)))
 93 | 
 94 | (defun forge-repository-list-setup (filter fn)
 95 |   (let ((buffer (get-buffer-create forge-repository-list-buffer-name)))
 96 |     (with-current-buffer buffer
 97 |       (setq default-directory "/")
 98 |       (setq forge--tabulated-list-columns forge-repository-list-columns)
 99 |       (setq forge--tabulated-list-query fn)
100 |       (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
101 |         (forge-repository-list-mode))
102 |       (setq forge--buffer-list-filter filter)
103 |       (forge--tablist-refresh)
104 |       (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t)
105 |       (tabulated-list-print)
106 |       (when hl-line-mode
107 |         (hl-line-highlight)))
108 |     (switch-to-buffer buffer)))
109 | 
110 | (defun forge-format-repo-condition (repo)
111 |   "Return a character representing the value of REPO's `condition' slot."
112 |   (pcase-exhaustive (oref repo condition)
113 |     (:tracked "*")
114 |     (:known " ")
115 |     (:stub (propertize "s" 'face 'warning))))
116 | 
117 | (defun forge-format-repo-selective (repo)
118 |   "Return a character representing the value of REPO's `selective-p' slot."
119 |   (pcase-exhaustive (oref repo selective-p)
120 |     ('t   "*")
121 |     ('nil " ")))
122 | 
123 | ;;; Commands
124 | ;;;; Menu
125 | 
126 | ;;;###autoload(autoload 'forge-repositories-menu "forge-repos" nil t)
127 | (transient-define-prefix forge-repositories-menu ()
128 |   "Control list of repositories displayed in the current buffer."
129 |   :transient-suffix t
130 |   :transient-non-suffix #'transient--do-call
131 |   :transient-switch-frame nil
132 |   :refresh-suffixes t
133 |   :environment #'forge--menu-environment
134 |   :column-widths forge--topic-menus-column-widths
135 |   [:hide always ("q" forge-menu-quit-list)]
136 |   [forge--topic-menus-group
137 |    forge--lists-group
138 |    ["Filter"
139 |     ("o" "owned" forge-list-owned-repositories
140 |      :if-nil forge--buffer-list-filter)
141 |     ("o" "owned" forge-list-repositories
142 |      :face forge-suffix-active
143 |      :if-non-nil forge--buffer-list-filter
144 |      :inapt-if-mode nil)]]
145 |   (interactive)
146 |   (unless (derived-mode-p 'forge-repository-list-mode)
147 |     (if-let ((buffer (get-buffer forge-repository-list-buffer-name)))
148 |         (switch-to-buffer buffer)
149 |       (forge-list-repositories)))
150 |   (transient-setup 'forge-repositories-menu))
151 | 
152 | (transient-augment-suffix forge-repositories-menu
153 |   :transient #'transient--do-replace
154 |   :if-mode 'forge-repository-list-mode
155 |   :inapt-if (##eq (oref transient--prefix command) 'forge-repositories-menu)
156 |   :inapt-face 'forge-suffix-active)
157 | 
158 | ;;;; List
159 | 
160 | (defclass forge--repo-list-command (transient-suffix)
161 |   ((type       :initarg :type   :initform nil)
162 |    (filter     :initarg :filter :initform nil)
163 |    (global     :initarg :global :initform nil)))
164 | 
165 | ;;;###autoload(autoload 'forge-list-repositories "forge-repos" nil t)
166 | (transient-define-suffix forge-list-repositories ()
167 |   "List known repositories in a separate buffer.
168 | Here \"known\" means that an entry exists in the local database."
169 |   :class 'forge--repo-list-command :type 'repo :global t
170 |   :inapt-if-mode 'forge-repository-list-mode
171 |   :inapt-face 'forge-suffix-active
172 |   (declare (interactive-only nil))
173 |   (interactive)
174 |   (forge-repository-list-setup nil #'forge--ls-repos)
175 |   (transient-setup 'forge-repositories-menu))
176 | 
177 | ;;;###autoload(autoload 'forge-list-owned-repositories "forge-repos" nil t)
178 | (transient-define-suffix forge-list-owned-repositories ()
179 |   "List your own known repositories in a separate buffer.
180 | Here \"known\" means that an entry exists in the local database
181 | and options `forge-owned-accounts' and `forge-owned-ignored'
182 | controls which repositories are considered to be owned by you.
183 | Only Github is supported for now."
184 |   :class 'forge--repo-list-command :type 'repo :filter 'owned :global t
185 |   (interactive)
186 |   (forge-repository-list-setup 'owned #'forge--ls-owned-repos)
187 |   (transient-setup 'forge-repositories-menu))
188 | 
189 | ;;; _
190 | ;; Local Variables:
191 | ;; read-symbol-shorthands: (
192 | ;;   ("partial" . "llama--left-apply-partially")
193 | ;;   ("rpartial" . "llama--right-apply-partially"))
194 | ;; End:
195 | (provide 'forge-repos)
196 | ;;; forge-repos.el ends here
197 | 


--------------------------------------------------------------------------------
/lisp/forge-revnote.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-revnote.el --- Revnote support  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'forge)
26 | (require 'forge-post)
27 | (require 'forge-topic)
28 | 
29 | ;;; Class
30 | 
31 | (defclass forge-revnote (forge-topic)
32 |   ((closql-table         :initform 'revnote)
33 |    (closql-primary-key   :initform 'id)
34 |    ;; (closql-order-by      :initform [(desc number)])
35 |    (closql-foreign-key   :initform 'repository)
36 |    (closql-class-prefix  :initform "forge-")
37 |    (id                   :initarg :id)
38 |    (repository           :initarg :repository)
39 |    (commit               :initarg :commit)
40 |    (file                 :initarg :file)
41 |    (line                 :initarg :line)
42 |    (author               :initarg :author)
43 |    (body                 :initarg :body)))
44 | 
45 | ;;; _
46 | ;; Local Variables:
47 | ;; read-symbol-shorthands: (
48 | ;;   ("partial" . "llama--left-apply-partially")
49 | ;;   ("rpartial" . "llama--right-apply-partially"))
50 | ;; End:
51 | (provide 'forge-revnote)
52 | ;;; forge-revnote.el ends here
53 | 


--------------------------------------------------------------------------------
/lisp/forge-semi.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-semi.el --- Support for semi-forges  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'forge)
26 | 
27 | ;;; Classes
28 | 
29 | (defclass forge-gitweb-repository (forge-noapi-repository)
30 |   ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r")
31 |    (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r")
32 |    (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary")
33 |    ;; We must use "hb=BRANCH" because "h=refs/heads/BRANCH" does not work
34 |    ;; here.  So "%r" stands for either "hb=BRANCH" or "h=HASH" and which
35 |    ;; it is, has to be handled as a special case in `forge-get-url(:blob)'.
36 |    (blob-url-format   :initform "https://%h/gitweb/?p=%P.git;a=blob;f=%s;%r"))
37 |   "Gitweb from https://git-scm.com/docs/gitweb.")
38 | 
39 | (defclass forge-cgit-repository (forge-noapi-repository)
40 |   ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r")
41 |    (branch-url-format :initform "https://%h/%p.git/log/?h=%r")
42 |    (remote-url-format :initform "https://%h/%p.git/about")
43 |    (blob-url-format   :initform "https://%h/%p.git/tree/%f?id=%r"))
44 |   "Cgit from https://git.zx2c4.com/cgit/about.
45 | Different hosts use different url schemata, so we need multiple
46 | classes.  See their definitions in \"forge-semi.el\".")
47 | 
48 | (defclass forge-cgit*-repository (forge-cgit-repository)
49 |   ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r")
50 |    (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r")
51 |    (remote-url-format :initform "https://%h/cgit/%p.git/about")
52 |    (blob-url-format   :initform "https://%h/cgit/%p.git/tree/%f?id=%r"))
53 |   "Cgit from https://git.zx2c4.com/cgit/about.
54 | Different hosts use different url schemata, so we need multiple
55 | classes.  See their definitions in \"forge-semi.el\".")
56 | 
57 | (defclass forge-cgit**-repository (forge-cgit-repository)
58 |   ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r")
59 |    (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r")
60 |    (remote-url-format :initform "https://%h/cgit/%n.git/about")
61 |    (blob-url-format   :initform "https://%h/cgit/%n.git/tree/%f?id=%r"))
62 |   "Cgit from https://git.zx2c4.com/cgit/about.
63 | Different hosts use different url schemata, so we need multiple
64 | classes.  See their definitions in \"forge-semi.el\".")
65 | 
66 | (defclass forge-repoorcz-repository (forge-cgit-repository)
67 |   ((commit-url-format :initform "https://%h/%p.git/commit/%r")
68 |    (branch-url-format :initform "https://%h/%p.git/log/%r")
69 |    (remote-url-format :initform "https://%h/%p.git")
70 |    (blob-url-format   :initform "https://%h/%p.git/blob/%r:/%f"))
71 |   "Cgit fork used on https://repo.or.cz/cgit.git.
72 | Different hosts use different url schemata, so we need multiple
73 | classes.  See their definitions in \"forge-semi.el\".")
74 | 
75 | (defclass forge-stagit-repository (forge-noapi-repository)
76 |   ((commit-url-format :initform "https://%h/%n/commit/%r.html")
77 |    (branch-url-format :initform "https://%h/%n/refs.html")
78 |    (remote-url-format :initform "https://%h/%n/file/README.html")
79 |    ;; Can only link to the tip of the main branch.
80 |    (blob-url-format   :initform "https://%h/%n/"))
81 |   "Stagit from https://codemadness.org/git/stagit/file/README.html.
82 | Only the history of \"master\" can be shown, so this links to the
83 | list of refs instead of the log of the specified branch.")
84 | 
85 | (defclass forge-srht-repository (forge-noapi-repository)
86 |   ((commit-url-format :initform "https://%h/~%o/%n/commit/%r")
87 |    (branch-url-format :initform "https://%h/~%o/%n/log/%r")
88 |    (remote-url-format :initform "https://%h/~%o/%n")
89 |    (blob-url-format   :initform "https://%h/~%o/%n/tree/%r/item/%f"))
90 |   "See https://meta.sr.ht.")
91 | 
92 | ;;; _
93 | (provide 'forge-semi)
94 | ;;; forge-semi.el ends here
95 | 


--------------------------------------------------------------------------------
/lisp/forge-tablist.el:
--------------------------------------------------------------------------------
 1 | ;;; forge-tablist.el --- Tabulated-list interface  -*- lexical-binding:t -*-
 2 | 
 3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
 4 | 
 5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
 7 | 
 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 9 | 
10 | ;; This file is free software: you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published
12 | ;; by the Free Software Foundation, either version 3 of the License,
13 | ;; or (at your option) any later version.
14 | ;;
15 | ;; This file is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | ;;
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
22 | 
23 | ;;; Code:
24 | 
25 | (require 'tabulated-list)
26 | 
27 | (require 'forge)
28 | 
29 | (defconst forge--tablist-columns-type
30 |   '(repeat
31 |     (list :tag "Column"
32 |           (string  :tag "Header Label")
33 |           (choice  :tag "Value source"
34 |                    function
35 |                    (symbol :tag "Object slot"))
36 |           (integer :tag "Column Width")
37 |           (choice  :tag "Sort predicate"
38 |                    (const :tag "Don't sort" nil)
39 |                    (const :tag "Default" t)
40 |                    function)
41 |           (plist   :tag "Properties"
42 |                    :key-type (choice :tag "Property"
43 |                                      (const :right-align)
44 |                                      (const :pad-right)
45 |                                      symbol)
46 |                    :value-type (sexp :tag "Value")))))
47 | 
48 | (defvar-local forge--tabulated-list-columns nil)
49 | (put 'forge--tabulated-list-columns 'permanent-local t)
50 | 
51 | (defvar-local forge--tabulated-list-query nil)
52 | (put 'forge--tabulated-list-query 'permanent-local t)
53 | 
54 | (defun forge--tablist-refresh ()
55 |   (setq tabulated-list-format
56 |         (vconcat (mapcar (pcase-lambda (`(,name ,_get ,width ,sort ,props))
57 |                            `(,name ,width ,sort . ,props))
58 |                          forge--tabulated-list-columns)))
59 |   (tabulated-list-init-header)
60 |   (setq tabulated-list-entries
61 |         (mapcar
62 |          (lambda (obj)
63 |            (list (oref obj id)
64 |                  (vconcat
65 |                   (mapcar (pcase-lambda (`(,_name ,get ,_width ,_sort ,_props))
66 |                             (let ((val (cond
67 |                                         ((functionp get)
68 |                                          (funcall get obj))
69 |                                         ((eq (car-safe get) 'repository)
70 |                                          (eieio-oref (forge-get-repository obj)
71 |                                                      (cadr get)))
72 |                                         ((eieio-oref obj get)))))
73 |                               (cond ((stringp val) val)
74 |                                     ((null val) "")
75 |                                     ((format "%s" val)))))
76 |                           forge--tabulated-list-columns))))
77 |          (funcall forge--tabulated-list-query))))
78 | 
79 | ;;; _
80 | ;; Local Variables:
81 | ;; read-symbol-shorthands: (
82 | ;;   ("partial" . "llama--left-apply-partially")
83 | ;;   ("rpartial" . "llama--right-apply-partially"))
84 | ;; End:
85 | (provide 'forge-tablist)
86 | ;;; forge-tablist.el ends here
87 | 


--------------------------------------------------------------------------------
/lisp/forge.el:
--------------------------------------------------------------------------------
  1 | ;;; forge.el --- Access Git forges from Magit  -*- lexical-binding:t -*-
  2 | 
  3 | ;; Copyright (C) 2018-2025 Jonas Bernoulli
  4 | 
  5 | ;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  6 | ;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
  7 | ;; Homepage: https://github.com/magit/forge
  8 | ;; Keywords: git tools vc
  9 | 
 10 | ;; Package-Version: 0.5.3
 11 | ;; Package-Requires: (
 12 | ;;     (emacs "29.1")
 13 | ;;     (compat "30.1")
 14 | ;;     (closql "2.2.2")
 15 | ;;     (emacsql "4.3.1")
 16 | ;;     (ghub "4.3.2")
 17 | ;;     (let-alist "1.0.6")
 18 | ;;     (llama "0.6.3")
 19 | ;;     (magit "4.3.6")
 20 | ;;     (markdown-mode "2.7")
 21 | ;;     (seq "2.24")
 22 | ;;     (transient "0.9.0")
 23 | ;;     (yaml "1.2.0"))
 24 | 
 25 | ;; SPDX-License-Identifier: GPL-3.0-or-later
 26 | 
 27 | ;; This file is free software: you can redistribute it and/or modify
 28 | ;; it under the terms of the GNU General Public License as published
 29 | ;; by the Free Software Foundation, either version 3 of the License,
 30 | ;; or (at your option) any later version.
 31 | ;;
 32 | ;; This file is distributed in the hope that it will be useful,
 33 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 34 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 35 | ;; GNU General Public License for more details.
 36 | ;;
 37 | ;; You should have received a copy of the GNU General Public License
 38 | ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
 39 | 
 40 | ;;; Commentary:
 41 | 
 42 | ;; Work with Git forges, such as Github and Gitlab, from the comfort
 43 | ;; of Magit and the rest of Emacs.
 44 | 
 45 | ;; The schema of the database has not been finalized yet.  Until that
 46 | ;; has happened it will occasionally have to be discarded.  For now
 47 | ;; the database does not contain any information that cannot simply
 48 | ;; be fetched again.
 49 | 
 50 | ;;; Code:
 51 | 
 52 | (require 'magit)
 53 | 
 54 | (require 'forge-db)
 55 | (require 'forge-core)
 56 | 
 57 | (provide 'forge)
 58 | 
 59 | (require 'forge-repo)
 60 | (require 'forge-post)
 61 | (require 'forge-topic)
 62 | (require 'forge-discussion)
 63 | (require 'forge-issue)
 64 | (require 'forge-pullreq)
 65 | (require 'forge-revnote)
 66 | (require 'forge-notify)
 67 | 
 68 | (require 'forge-forgejo)
 69 | (require 'forge-github)
 70 | (require 'forge-gitlab)
 71 | (require 'forge-gitea)
 72 | (require 'forge-gogs)
 73 | (require 'forge-bitbucket)
 74 | (require 'forge-semi)
 75 | 
 76 | (require 'forge-commands)
 77 | (require 'forge-topics)
 78 | (require 'forge-repos)
 79 | 
 80 | ;;; Add Sections
 81 | 
 82 | (defvar forge-add-default-sections t
 83 |   "Whether to add Forge's sections to `magit-status-sections-hook'.
 84 | 
 85 | If you want to disable this, then you must set this to nil before
 86 | `forge' is loaded.")
 87 | 
 88 | (when forge-add-default-sections
 89 |   (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs    nil t)
 90 |   (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues      nil t)
 91 |   (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-discussions nil t))
 92 | 
 93 | ;;; Add Bindings
 94 | 
 95 | ;;;###autoload
 96 | (defvar forge-add-default-bindings t
 97 |   "Whether to add Forge's bindings to various Magit keymaps.
 98 | 
 99 | If you want to disable this, then you must set this to nil before
100 | `magit' is loaded.  If you do it before `forge' but after `magit'
101 | is loaded, then `magit-mode-map' ends up being modified anyway.")
102 | 
103 | ;;;###autoload
104 | (with-eval-after-load 'magit-mode
105 |   (when forge-add-default-bindings
106 |     (keymap-set magit-mode-map "'" #'forge-dispatch)
107 |     (keymap-set magit-mode-map "N" #'forge-dispatch)
108 |     (keymap-set magit-mode-map "<remap> <magit-browse-thing>"
109 |                 #'forge-browse)
110 |     (keymap-set magit-mode-map "<remap> <magit-copy-thing>"
111 |                 #'forge-copy-url-at-point-as-kill)))
112 | 
113 | ;;;###autoload
114 | (with-eval-after-load 'magit-repos
115 |   (when forge-add-default-bindings
116 |     (keymap-set magit-repolist-mode-map "N" #'forge-dispatch)))
117 | 
118 | ;;;###autoload
119 | (with-eval-after-load 'git-commit
120 |   (when forge-add-default-bindings
121 |     (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
122 | 
123 | (when forge-add-default-bindings
124 |   (keymap-set magit-commit-section-map "C-c C-v" #'forge-visit-topic)
125 |   (keymap-set magit-branch-section-map "C-c C-v" #'forge-visit-topic)
126 | 
127 |   (transient-insert-suffix 'magit-dispatch "o"
128 |     '("N" "Forge" forge-dispatch))
129 | 
130 |   (transient-append-suffix 'magit-fetch "m" '("n" forge-pull))
131 |   (transient-append-suffix 'magit-fetch "n" '("N" forge-pull-notifications))
132 | 
133 |   (transient-append-suffix 'magit-pull  "m" '("n" forge-pull))
134 |   (transient-append-suffix 'magit-pull  "n" '("N" forge-pull-notifications))
135 | 
136 |   (transient-append-suffix 'magit-branch "w"
137 |     '("f" "pull-request" forge-checkout-pullreq))
138 |   (transient-append-suffix 'magit-branch "W"
139 |     '("F" "from pull-request" forge-branch-pullreq))
140 | 
141 |   (transient-append-suffix 'magit-remote "a"
142 |     '("f" "Fork" forge-fork))
143 |   (transient-insert-suffix 'magit-remote "d u"
144 |     '("d s" "Set default branch" forge-set-default-branch))
145 |   (transient-append-suffix 'magit-remote "d u"
146 |     '("d r" "Rename default branch" forge-rename-default-branch))
147 | 
148 |   (transient-append-suffix 'magit-worktree "c"
149 |     '("n" "pull-request worktree" forge-checkout-worktree))
150 | 
151 |   (transient-append-suffix 'magit-status-jump "w"
152 |     '("Np" "Pull requests" forge-jump-to-pullreqs))
153 |   (transient-append-suffix 'magit-status-jump "Np"
154 |     '("Ni" "Issues" forge-jump-to-issues))
155 | 
156 |   (transient-append-suffix 'magit-merge "a"
157 |     '(7 "M" "Merge using API" forge-merge)))
158 | 
159 | ;;; Startup Asserts
160 | 
161 | (defconst forge--minimal-git "2.25.0")
162 | 
163 | (defun forge-startup-asserts ()
164 |   (let ((version (magit-git-version)))
165 |     (when (and version (version< version forge--minimal-git))
166 |       (display-warning 'magit (format "\
167 | Forge requires Git >= %s, you are using %s.
168 | 
169 | If this comes as a surprise to you, because you do actually have
170 | a newer version installed, then that probably means that the
171 | older version happens to appear earlier on the `$PATH'.  If you
172 | always start Emacs from a shell, then that can be fixed in the
173 | shell's init file.  If you start Emacs by clicking on an icon,
174 | or using some sort of application launcher, then you probably
175 | have to adjust the environment as seen by graphical interface.
176 | For X11 something like ~/.xinitrc should work.
177 | 
178 | If you use Tramp to work inside remote Git repositories, then you
179 | have to make sure a suitable Git is used on the remote machines
180 | too.\n" forge--minimal-git version) :error))))
181 | 
182 | (if after-init-time
183 |     (forge-startup-asserts)
184 |   (add-hook 'after-init-hook #'forge-startup-asserts t))
185 | 
186 | ;;; _
187 | ;; Local Variables:
188 | ;; read-symbol-shorthands: (
189 | ;;   ("partial" . "llama--left-apply-partially")
190 | ;;   ("rpartial" . "llama--right-apply-partially"))
191 | ;; End:
192 | ;;; forge.el ends here
193 | 


--------------------------------------------------------------------------------