-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
macports-describe.el
245 lines (213 loc) · 10.3 KB
/
macports-describe.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
;;; macports-describe.el --- A porcelain for MacPorts -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Aaron Madlon-Kay
;; Author: Aaron Madlon-Kay
;; Version: 0.1.0
;; URL: https://github.com/amake/macports.el
;; Keywords: convenience
;; This file is not part of GNU Emacs.
;; macports-describe.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 3, or (at your option) any later version.
;;
;; macports-describe.el is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;;
;; You should have received a copy of the GNU General Public License along with
;; macports-describe.el. If not, see http://www.gnu.org/licenses.
;;; Commentary:
;; A porcelain for MacPorts: major mode for viewing details about a port
;;; Code:
(require 'macports-core)
(require 'thingatpt)
(defface macports-describe-heading
'((t (:weight bold)))
"Face used for headings in MacPorts Describe buffers."
:group 'macports)
(defface macports-describe-loading
'((t (:slant italic)))
"Face used for loading text in MacPorts Describe buffers."
:group 'macports)
(defface macports-describe-port-button-hover
'((t (:underline t)))
"Face used when mouse-hovering over link buttons to other ports."
:group 'macports)
(defface macports-describe-build-test-only-rdeps
'((t (:slant italic)))
"Face used for build- or test-only rdeps text in MacPorts Describe buffers."
:group 'macports)
(defvar-local macports-describe--status nil
"A variable indicating the buffer's loading status.")
(defun macports-describe-port (port)
"Display detailed information about PORT."
(interactive (list (macports-core--prompt-port)))
(let* ((buf-name (format "*Port: %s*" port))
(buf (get-buffer buf-name)))
(if buf
(pop-to-buffer buf)
(macports-describe--init-buffer port (get-buffer-create buf-name)))))
(defun macports-describe--init-buffer (port buf)
"Init help BUF describing PORT."
(with-help-window buf
(with-current-buffer standard-output
(setq-local revert-buffer-function
(lambda (&rest _)
(macports-describe--init-buffer port buf)))
(setq-local macports-describe--status (list :rdependents nil :rdeps nil :rdeps-build-test-only nil))
(macports-dispatch-mode)
(shell-command (concat macports-command " -q info " port) standard-output)
(macports-describe--linkify-urls)
(macports-describe--linkify-emails)
(macports-describe--linkify-github)
(macports-describe--linkify-ports-in-headers
"Replaced by:" "Sub-ports:" "Fetch Dependencies:" "Extract Dependencies:" "Build Dependencies:"
"Library Dependencies:" "Runtime Dependencies:" "Test Dependencies:" "Conflicts with:")
(macports-describe--style-headings)
(goto-char (point-max))
(macports-describe--heading "Dependents:")
(macports-describe--async-insert
(concat macports-command " -q rdependents " port) "None\n"
(lambda (s-marker e-marker had-output succeeded)
(if (and had-output succeeded)
(macports-describe--linkify-ports (marker-position s-marker) (marker-position e-marker)))
(macports-describe--update-status :rdependents t)
(macports-describe--dispose-markers s-marker e-marker)))
(macports-describe--heading "Deps:")
(macports-describe--async-insert
(concat macports-command " -q rdeps " port) "None\n"
(lambda (s-marker e-marker had-output succeeded)
(macports-describe--update-status :rdeps t)
(if (and had-output succeeded)
(progn
(macports-describe--linkify-ports (marker-position s-marker) (marker-position e-marker))
(macports-describe--async-mark-build-test-rdeps port s-marker e-marker))
(macports-describe--update-status :rdeps-build-test-only t))))
;; Return the created buffer, which is the current buffer
(current-buffer))))
(defun macports-describe--heading (text)
"Insert a heading with content TEXT."
(insert (format "\n%s\n" (propertize text 'face 'macports-describe-heading))))
(defun macports-describe--async-insert (command empty-msg callback)
"Insert output of COMMAND with temporary loading message.
If result is blank, show EMPTY-MSG instead.
CALLBACK is a function that accepts:
- The start marker of the inserted text
- The end marker of the inserted text
- A boolean that is nil if EMPTY-MSG was used
- A boolean that is nil if the command exited with an error
CALLBACK is responsible for setting the markers to nil when finished."
(let ((s-marker (point-marker))
e-marker
(buf (current-buffer)))
(insert (propertize "Loading..." 'face 'macports-describe-loading))
(setq e-marker (point-marker))
(macports-core--async-shell-command-to-string
command
(lambda (result exit-status)
(with-current-buffer buf
(save-excursion
(let* ((inhibit-read-only t)
(cleaned (replace-regexp-in-string "\r" "" result))
(had-output (not (string-blank-p cleaned))))
(delete-region (marker-position s-marker) (marker-position e-marker))
(goto-char (marker-position s-marker))
(insert (if had-output cleaned empty-msg))
(set-marker e-marker (point))
(funcall callback s-marker e-marker had-output (= exit-status 0)))))))))
(defun macports-describe--linkify-urls ()
"Linkify URLs in current buffer."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "https?://[^ \n]+" nil t)
(pcase-let ((url (thing-at-point-url-at-point))
(`(,beg . ,end) (bounds-of-thing-at-point 'url)))
(delete-region beg end)
(help-insert-xref-button url 'help-url url)))))
(defun macports-describe--linkify-emails ()
"Linkify email addresses in current buffer."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "[^[:blank:]]+@[^[:blank:]]" nil t)
;; Using 'email fails in cases where the email contains a number, so we
;; use 'symbol which happens to give good results.
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=61519
(pcase-let ((email (thing-at-point 'symbol))
(`(,beg . ,end) (bounds-of-thing-at-point 'symbol)))
(delete-region beg end)
(help-insert-xref-button email 'help-url (concat "mailto:" email))))))
(defun macports-describe--linkify-github ()
"Linkify GitHub usernames in current buffer."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "GitHub:[[:blank:]\n]*[^[:blank:]]" nil t)
(pcase-let ((username (thing-at-point 'symbol))
(`(,beg . ,end) (bounds-of-thing-at-point 'symbol)))
(delete-region beg end)
(help-insert-xref-button username 'help-url (concat "https://github.com/" username))))))
(defun macports-describe--style-headings ()
"Apply heading style to current buffer content."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[^[:blank:]][^:\n]+:" nil t)
(add-text-properties (match-beginning 0) (match-end 0) '(face macports-describe-heading)))))
(defun macports-describe--linkify-ports-in-headers (&rest headers)
"Linkify ports listed under the specified HEADERS."
(save-excursion
(dolist (header headers)
(goto-char (point-min))
(when (re-search-forward (concat "^" header) nil t)
(let ((start (match-end 0))
(end (save-excursion (and (re-search-forward "^[^[:blank:]]" nil t) (match-beginning 0)))))
(macports-describe--linkify-ports start end))))))
(defun macports-describe--linkify-ports (start end)
"Linkify ports between START and END."
(save-excursion
(goto-char start)
(while (re-search-forward "[^[:blank:]\n,]+" end t)
(let ((start (match-beginning 0))
(end (match-end 0))
(port (match-string-no-properties 0)))
(make-text-button
start end
'action (lambda (_) (macports-describe-port port))
'face 'default
'mouse-face 'macports-describe-port-button-hover)))))
(defun macports-describe--async-mark-build-test-rdeps (port s-marker e-marker)
"Mark build/test-only rdeps for PORT within the bounded region.
Will null-out S-MARKER and E-MARKER markers upon completion."
(let ((buf (current-buffer)))
(macports-core--async-shell-command-to-string
(concat macports-command " -q rdeps --no-build --no-test " port)
(lambda (result _exit-status)
(with-current-buffer buf
(save-excursion
(goto-char (marker-position s-marker))
(let (had-build-test-only
(inhibit-read-only t)
(no-build (split-string (string-trim result))))
(while (re-search-forward "[^[:blank:]\n]+" (marker-position e-marker) t)
(let ((dep (match-string-no-properties 0)))
(unless (member dep no-build)
(add-text-properties (match-beginning 0) (match-end 0) '(face macports-describe-build-test-only-rdeps))
(insert "*")
(setq had-build-test-only t))))
(when had-build-test-only
(goto-char (marker-position e-marker))
(insert "\n *Build- or test-only dependency"))))
(macports-describe--dispose-markers s-marker e-marker)
(macports-describe--update-status :rdeps-build-test-only t))))))
(defun macports-describe--update-status (key value)
"Update the load status with KEY and VALUE."
(setq macports-describe--status (plist-put macports-describe--status key value)))
(defun macports-describe--dispose-markers (&rest markers)
"Dispose of all MARKERS."
(mapc (lambda (m) (set-marker m nil)) markers))
(defun macports-describe-port-contents (port)
"Display contents of PORT in a new buffer."
(with-help-window (get-buffer-create (format "*Port contents: %s*" port))
(with-current-buffer standard-output
(macports-dispatch-mode)
(shell-command (concat macports-command " -q contents " port) standard-output))))
(provide 'macports-describe)
;;; macports-describe.el ends here