-
Notifications
You must be signed in to change notification settings - Fork 7
/
aurel.el
1895 lines (1630 loc) · 69.4 KB
/
aurel.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
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; aurel.el --- Search, get info, vote for and download AUR packages -*- lexical-binding: t -*-
;; Copyright (C) 2014-2017 Alex Kost
;; Author: Alex Kost <[email protected]>
;; Created: 6 Feb 2014
;; Version: 0.9
;; URL: https://github.com/alezost/aurel
;; Keywords: tools
;; Package-Requires: ((emacs "24.3") (bui "1.1.0") (dash "2.11.0"))
;; This program 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 of the License, or
;; (at your option) any later version.
;;
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an interface for searching, getting information,
;; voting for, subscribing and downloading packages from the Arch User
;; Repository (AUR) <https://aur.archlinux.org/>.
;; To manually install the package, add the following to your init-file:
;;
;; (add-to-list 'load-path "/path/to/aurel-dir")
;; (autoload 'aurel-package-info "aurel" nil t)
;; (autoload 'aurel-package-search "aurel" nil t)
;; (autoload 'aurel-package-search-by-name "aurel" nil t)
;; (autoload 'aurel-maintainer-search "aurel" nil t)
;; (autoload 'aurel-installed-packages "aurel" nil t)
;; Also set a directory where downloaded packages will be put:
;;
;; (setq aurel-download-directory "~/aur")
;; To search for packages, use `aurel-package-search' or
;; `aurel-maintainer-search' commands. If you know the name of a
;; package, use `aurel-package-info' command. Also you can display a
;; list of installed AUR packages with `aurel-installed-packages'.
;; Information about the packages is represented in a list-like buffer
;; similar to a buffer containing emacs packages. Press "h" to see a
;; hint (a summary of the available key bindings). To get more info
;; about a package (or marked packages), press "RET". To download a
;; package, press "d" (don't forget to set `aurel-download-directory'
;; before). In a list buffer, you can mark several packages for
;; downloading with "m"/"M" (and unmark with "u"/"U" and "DEL"); also
;; you can perform filtering (press "f f" to enable a filter and "f d"
;; to disable all filters) of a current list to hide particular
;; packages.
;; It is possible to move to the previous/next displayed results with
;; "l"/"r" (each aurel buffer has its own history) and to refresh
;; information with "g".
;; After receiving information about the packages, pacman is called to
;; find what packages are installed. To disable that, set
;; `aurel-installed-packages-check' to nil.
;; To vote/subscribe for a package, press "v"/"s" (with prefix,
;; unvote/unsubscribe) in a package info buffer (you should have an AUR
;; account for that). To add information about "Voted"/"Subscribed"
;; status, use the following:
;;
;; (setq aurel-aur-user-package-info-check t)
;; For full description and screenshots, see
;; <https://github.com/alezost/aurel>.
;;; Code:
(require 'url)
(require 'url-handlers)
(require 'json)
(require 'cl-lib)
(require 'dash)
(require 'bui)
(defgroup aurel nil
"Search for and download AUR (Arch User Repository) packages."
:group 'applications)
(defgroup aurel-faces nil
"Faces for 'aurel' buffers."
:group 'aurel
:group 'faces)
(defcustom aurel-aur-user-package-info-check nil
"If non-nil, check additional info before displaying a package info.
Additional info is an AUR user specific information (whether the user
voted for the package or subscribed to receive comments)."
:type 'boolean
:group 'aurel)
(defvar aurel-unknown-string "Unknown"
"String used if a value of the parameter is unknown.")
(defvar aurel-none-string "None"
"String saying that a parameter has no value.
This string can be displayed by pacman.")
(defvar aurel-package-name-re
"[-+_[:alnum:]]+"
"Regexp matching a valid package name.")
;;; Debugging
(defvar aurel-debug-level 0
"If > 0, display debug messages in `aurel-debug-buffer'.
The greater the number, the more messages is printed.
Max level is 9.")
(defvar aurel-debug-buffer "*aurel debug*"
"Name of a buffer containing debug messages.")
(defvar aurel-debug-time-format "%T.%3N"
"Time format used for debug mesages.")
(defun aurel-debug (level msg &rest args)
"Print debug message if needed.
If `aurel-debug-level' >= LEVEL, print debug message MSG with
arguments ARGS into `aurel-debug-buffer'.
Return nil."
(when (>= aurel-debug-level level)
(with-current-buffer (get-buffer-create aurel-debug-buffer)
(goto-char (point-max))
(insert (format-time-string aurel-debug-time-format (current-time)))
(insert " " (apply 'format msg args) "\n")))
nil)
;;; Interacting with AUR server
(defcustom aurel-aur-user-name ""
"User name for AUR."
:type 'string
:group 'aurel)
(defvar aurel-aur-host "aur.archlinux.org"
"AUR domain.")
(defvar aurel-aur-base-url (concat "https://" aurel-aur-host)
"Root URL of the AUR service.")
(defvar aurel-aur-login-url
(url-expand-file-name "login" aurel-aur-base-url)
"Login URL.")
(defconst aurel-aur-cookie-name "AURSID"
"Cookie name used for AUR login.")
;; Avoid compilation warning about `url-http-response-status'
(defvar url-http-response-status)
(defun aurel-check-response-status (buffer &optional noerror)
"Return t, if URL response status in BUFFER is 2XX or 3XX.
Otherwise, throw an error or return nil, if NOERROR is nil."
(with-current-buffer buffer
(aurel-debug 3 "Response status: %s" url-http-response-status)
(if (or (null (numberp url-http-response-status))
(> url-http-response-status 399))
(unless noerror (error "Error during request: %s"
url-http-response-status))
t)))
(defun aurel-receive-parse-info (url)
"Return received output from URL processed with `json-read'."
(aurel-debug 3 "Retrieving %s" url)
(with-temp-buffer
(url-insert-file-contents url)
(goto-char (point-min))
(let ((json-key-type 'string)
(json-array-type 'list)
(json-object-type 'alist))
(json-read))))
(defun aurel-get-aur-packages-info (url)
"Return information about the packages from URL.
Output from URL should be a json data. It is parsed with
`json-read'.
Returning value is alist of AUR package parameters (strings from
`aurel-aur-param-alist') and their values."
(let* ((full-info (aurel-receive-parse-info url))
(type (cdr (assoc "type" full-info)))
(count (cdr (assoc "resultcount" full-info)))
(results (cdr (assoc "results" full-info))))
(cond
((string= type "error")
(error "%s" results))
((= count 0)
nil)
(t
(when (string= type "info")
(setq results (list results)))
results))))
;; Because of the bug <http://bugs.gnu.org/16960>, we can't use
;; `url-retrieve-synchronously' (or any other simple call of
;; `url-retrieve', as the callback is never called) to login to
;; <https://aur.archlinux.org>. So we use
;; `aurel-url-retrieve-synchronously' - it is almost the same, except it
;; can exit from the waiting loop when a buffer with received data
;; appears in `url-dead-buffer-list'. This hack is currently possible,
;; because `url-http-parse-headers' marks the buffer as dead when it
;; returns nil.
(defun aurel-url-retrieve-synchronously (url &optional silent inhibit-cookies)
"Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
associated with it (the case for dired, info, or mailto URLs that need
no further processing). URL is either a string or a parsed URL.
See `url-retrieve' for SILENT and INHIBIT-COOKIES."
(url-do-setup)
(let (asynch-buffer retrieval-done)
(setq asynch-buffer
(url-retrieve url
(lambda (&rest ignored)
(url-debug 'retrieval
"Synchronous fetching done (%S)"
(current-buffer))
(setq retrieval-done t
asynch-buffer (current-buffer)))
nil silent inhibit-cookies))
(when asynch-buffer
(let ((proc (get-buffer-process asynch-buffer)))
(while (not (or retrieval-done
;; retrieval can be done even if
;; `retrieval-done' is nil (see the comment
;; above)
(memq asynch-buffer url-dead-buffer-list)))
(url-debug 'retrieval
"Spinning in url-retrieve-synchronously: %S (%S)"
retrieval-done asynch-buffer)
(if (buffer-local-value 'url-redirect-buffer asynch-buffer)
(setq proc (get-buffer-process
(setq asynch-buffer
(buffer-local-value 'url-redirect-buffer
asynch-buffer))))
(if (and proc (memq (process-status proc)
'(closed exit signal failed))
;; Make sure another process hasn't been started.
(eq proc (or (get-buffer-process asynch-buffer) proc)))
(progn ;; Call delete-process so we run any sentinel now.
(delete-process proc)
(setq retrieval-done t)))
(unless (or (with-local-quit
(accept-process-output proc))
(null proc))
(when quit-flag
(delete-process proc))
(setq proc (and (not quit-flag)
(get-buffer-process asynch-buffer)))))))
asynch-buffer)))
(defun aurel-url-post (url args &optional inhibit-cookies)
"Send ARGS to URL as a POST request.
ARGS is alist of field names and values to send.
Return the buffer with the received data.
If INHIBIT-COOKIES is non-nil, do not use saved cookies."
(let ((url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (aurel-get-fields-string args)))
(aurel-debug 2 "POSTing to %s" url)
(aurel-url-retrieve-synchronously url inhibit-cookies)))
(defun aurel-get-aur-cookie ()
"Return cookie for AUR login.
Return nil, if there is no such cookie or it is expired."
(url-do-setup) ; initialize cookies
(let* ((cookies (url-cookie-retrieve aurel-aur-host "/" t))
(cookie (car (cl-member-if
(lambda (cookie)
(equal (url-cookie-name cookie)
aurel-aur-cookie-name))
cookies))))
(if (null cookie)
(aurel-debug 4 "AUR login cookie not found")
(if (url-cookie-expired-p cookie)
(aurel-debug 4 "AUR login cookie is expired")
(aurel-debug 4 "AUR login cookie is valid")
cookie))))
(declare-function auth-source-search "auth-source" t)
(defun aurel-aur-login-maybe (&optional force noerror)
"Login to AUR, use cookie if possible.
If FORCE is non-nil (interactively, with prefix), prompt for
credentials and login without trying the cookie.
See `aurel-aur-login' for the meaning of NOERROR and returning value."
(interactive "P")
(if (aurel-get-aur-cookie)
(progn
(aurel-debug 2 "Using cookie instead of a real login")
t)
(let (user password)
(let ((auth (car (auth-source-search :host aurel-aur-host))))
(when auth
(let ((secret (plist-get auth :secret)))
(setq user (plist-get auth :user)
password (if (functionp secret)
(funcall secret)
secret)))))
(when (or force (null user))
(setq user (read-string "AUR user name: " aurel-aur-user-name)))
(when (or force (null password))
(setq password (read-passwd "Password: ")))
(aurel-aur-login user password t noerror))))
(defun aurel-aur-login (user password &optional remember noerror)
"Login to AUR with USER and PASSWORD.
If REMEMBER is non-nil, remember a cookie.
Return t, if login was successful, otherwise throw an error or
return nil, if NOERROR is non-nil."
(let ((buf (aurel-url-post
aurel-aur-login-url
(list (cons "user" user)
(cons "passwd" password)
(cons "remember_me" (if remember "on" "off")))
'inhibit-cookie)))
(when (aurel-check-response-status buf noerror)
(with-current-buffer buf
(if (re-search-forward "errorlist.+<li>\\(.+\\)</li>" nil t)
(let ((err (match-string 1)))
(aurel-debug 1 "Error during login: %s" )
(or noerror (error "%s" err))
nil)
(url-cookie-write-file)
(aurel-debug 1 "Login for %s is successful" user)
t)))))
(defun aurel-add-aur-user-package-info (info)
"Return a new info by adding AUR user info to package INFO.
See `aurel-aur-user-package-info-check' for the meaning of
additional info."
(let ((add (aurel-get-aur-user-package-info
(aurel-get-aur-package-url
(bui-entry-value info 'name)))))
(if add
(cons (cons 'user-info add)
info)
info)))
(defun aurel-get-aur-user-package-info (url)
"Return AUR user specific information about a package from URL.
Returning value is alist of package parameters specific for AUR
user (`voted' and `subscribed') and their values.
Return nil, if information is not found."
(when (aurel-aur-login-maybe nil t)
(aurel-debug 3 "Retrieving %s" url)
(let ((buf (url-retrieve-synchronously url)))
(aurel-debug 4 "Searching in %S for voted/subscribed params" buf)
(list (cons 'voted
(aurel-aur-package-voted buf))
(cons 'subscribed
(aurel-aur-package-subscribed buf))))))
(defun aurel-aur-package-voted (buffer)
"Return `voted' parameter value from BUFFER with fetched data.
Return non-nil if a package is voted by the user; nil if it is not;
`aurel-unknown-string' if the information is not found.
BUFFER should contain html data about the package."
(cond
((aurel-search-in-buffer
(aurel-get-aur-user-action-name 'vote) buffer)
nil)
((aurel-search-in-buffer
(aurel-get-aur-user-action-name 'unvote) buffer)
t)
(t aurel-unknown-string)))
(defun aurel-aur-package-subscribed (buffer)
"Return `subscribed' parameter value from BUFFER with fetched data.
Return non-nil if a package is subscribed by the user; nil if it is not;
`aurel-unknown-string' if the information is not found.
BUFFER should contain html data about the package."
(cond
((aurel-search-in-buffer
(aurel-get-aur-user-action-name 'subscribe) buffer)
nil)
((aurel-search-in-buffer
(aurel-get-aur-user-action-name 'unsubscribe) buffer)
t)
(t aurel-unknown-string)))
(defun aurel-search-in-buffer (regexp buffer)
"Return non-nil if BUFFER contains REGEXP; return nil otherwise."
(with-current-buffer buffer
(goto-char (point-min))
(let ((res (re-search-forward regexp nil t)))
(aurel-debug 7 "Searching for %s in %S: %S" regexp buffer res)
res)))
(defvar aurel-aur-user-actions
'((vote "do_Vote" "vote" "Vote for '%s' package?")
(unvote "do_UnVote" "unvote" "Remove vote from '%s' package?")
(subscribe "do_Notify" "notify" "Enable notifications for '%s' package?")
(unsubscribe "do_UnNotify" "unnotify" "Disable notifications for '%s' package?"))
"Alist of the available actions.
Each association has the following form:
(SYMBOL NAME URL-END CONFIRM)
SYMBOL is a name of the action used internally in code of this package.
NAME is a name (string) used in the html-code of AUR package page.
URL-END is appended to the package URL; used for posting the action.
CONFIRM is a prompt to confirm the action or nil if it is not required.")
(defun aurel-get-aur-user-action-name (action)
"Return the name of an ACTION."
(cadr (assoc action aurel-aur-user-actions)))
(defun aurel-aur-user-action (action package-base)
"Perform AUR user ACTION on the PACKAGE-BASE.
ACTION is a symbol from `aurel-aur-user-actions'.
PACKAGE-BASE is a name of the package base (string).
Return non-nil, if ACTION was performed; return nil otherwise."
(let ((assoc (assoc action aurel-aur-user-actions)))
(let ((action-name (nth 1 assoc))
(url-end (nth 2 assoc))
(confirm (nth 3 assoc)))
(when (or (null confirm)
(y-or-n-p (format confirm package-base)))
(aurel-aur-login-maybe)
(aurel-url-post
(aurel-get-package-action-url package-base url-end)
(list (cons "token" (url-cookie-value (aurel-get-aur-cookie)))
(cons action-name "")))
t))))
;;; Interacting with pacman
(defcustom aurel-pacman-program (executable-find "pacman")
"Absolute or relative name of `pacman' program."
:type 'string
:group 'aurel)
(defvar aurel-pacman-locale "C"
"Default locale used to start pacman.")
(defcustom aurel-installed-packages-check
(and aurel-pacman-program t)
"If non-nil, check if the found packages are installed.
If nil, searching works faster, because `aurel-pacman-program' is not
called, but it stays unknown if a package is installed or not."
:type 'boolean
:group 'aurel)
(defvar aurel-pacman-buffer-name " *aurel-pacman*"
"Name of the buffer used internally for pacman output.")
(defvar aurel-pacman-info-line-re
(rx line-start
(group (+? (any word " ")))
(+ " ") ":" (+ " ")
(group (+ any) (* (and "\n " (+ any))))
line-end)
"Regexp matching a line of pacman query info output.
Contain 2 parenthesized groups: parameter name and its value.")
(defun aurel-call-pacman (&optional buffer &rest args)
"Call `aurel-pacman-program' with arguments ARGS.
Insert output in BUFFER. If it is nil, use `aurel-pacman-buffer-name'.
Return numeric exit status."
(or aurel-pacman-program
(error (concat "Couldn't find pacman.\n"
"Set aurel-pacman-program to a proper value")))
(with-current-buffer
(or buffer (get-buffer-create aurel-pacman-buffer-name))
(erase-buffer)
(let ((process-environment
(cons (concat "LC_ALL=" aurel-pacman-locale)
process-environment)))
(apply #'call-process aurel-pacman-program nil t nil args))))
(defun aurel-get-foreign-packages ()
"Return list of names of installed foreign packages."
(let ((buf (get-buffer-create aurel-pacman-buffer-name)))
(aurel-call-pacman buf "--query" "--foreign")
(aurel-pacman-query-names-buffer-parse buf)))
(defun aurel-pacman-query-names-buffer-parse (&optional buffer)
"Parse BUFFER with packages names.
BUFFER should contain an output returned by 'pacman -Q' command.
If BUFFER is nil, use `aurel-pacman-buffer-name'.
Return list of names of packages."
(with-current-buffer
(or buffer (get-buffer-create aurel-pacman-buffer-name))
(goto-char (point-min))
(let (names)
(while (re-search-forward
(concat "^\\(" aurel-package-name-re "\\) ") nil t)
(setq names (cons (match-string 1) names)))
names)))
(defun aurel-get-installed-packages-info (&rest names)
"Return information about installed packages NAMES.
Each name from NAMES should be a string (a name of a package).
Returning value is a list of alists with installed package
parameters (strings from `aurel-installed-param-alist') and their
values."
(let ((buf (get-buffer-create aurel-pacman-buffer-name)))
(apply 'aurel-call-pacman buf "--query" "--info" names)
(aurel-pacman-query-buffer-parse buf)))
(defun aurel-pacman-query-buffer-parse (&optional buffer)
"Parse BUFFER with packages info.
BUFFER should contain an output returned by 'pacman -Qi' command.
If BUFFER is nil, use `aurel-pacman-buffer-name'.
Return list of alists with parameter names and values."
(with-current-buffer
(or buffer (get-buffer-create aurel-pacman-buffer-name))
(let ((beg (point-min))
end info)
;; Packages info are separated with empty lines, search for those
;; till the end of buffer
(cl-loop
do (progn
(goto-char beg)
(setq end (re-search-forward "^\n" nil t))
(and end
(setq info (aurel-pacman-query-region-parse beg end)
beg end)))
while end
if info collect info))))
(defun aurel-pacman-query-region-parse (beg end)
"Parse text (package info) in current buffer from BEG to END.
Parsing region should be an output for one package returned by
'pacman -Qi' command.
Return alist with parameter names and values."
(goto-char beg)
(let (point)
(cl-loop
do (setq point (re-search-forward
aurel-pacman-info-line-re end t))
while point
collect (cons (match-string 1) (match-string 2)))))
;;; Package parameters
(defvar aurel-aur-param-alist
'((pkg-url . "URLPath")
(home-url . "URL")
(last-date . "LastModified")
(first-date . "FirstSubmitted")
(outdated . "OutOfDate")
(votes . "NumVotes")
(popularity . "Popularity")
(license . "License")
(description . "Description")
(keywords . "Keywords")
(version . "Version")
(name . "Name")
(id . "ID")
(base-name . "PackageBase")
(base-id . "PackageBaseID")
(maintainer . "Maintainer")
(replaces . "Replaces")
(provides . "Provides")
(conflicts . "Conflicts")
(depends . "Depends")
(depends-make . "MakeDepends"))
"Association list of symbols and names of package info parameters.
Car of each assoc is a symbol used in code of this package.
Cdr - is a parameter name (string) returned by the AUR server.")
(defvar aurel-pacman-param-alist
'((installed-name . "Name")
(installed-version . "Version")
(architecture . "Architecture")
(installed-provides . "Provides")
(installed-depends . "Depends On")
(depends-opt . "Optional Deps")
(script . "Install Script")
(reason . "Install Reason")
(validated . "Validated By")
(required . "Required By")
(optional-for . "Optional For")
(installed-conflicts . "Conflicts With")
(installed-replaces . "Replaces")
(installed-size . "Installed Size")
(packager . "Packager")
(build-date . "Build Date")
(install-date . "Install Date"))
"Association list of symbols and names of package info parameters.
Car of each assoc is a symbol used in code of this package.
Cdr - is a parameter name (string) returned by pacman.")
(defun aurel-get-aur-param-name (param-symbol)
"Return a name (string) of a parameter.
PARAM-SYMBOL is a symbol from `aurel-aur-param-alist'."
(cdr (assoc param-symbol aurel-aur-param-alist)))
(defun aurel-get-aur-param-symbol (param-name)
"Return a symbol name of a parameter.
PARAM-NAME is a string from `aurel-aur-param-alist'."
(car (rassoc param-name aurel-aur-param-alist)))
(defun aurel-get-pacman-param-name (param-symbol)
"Return a name (string) of a parameter.
PARAM-SYMBOL is a symbol from `aurel-pacman-param-alist'."
(cdr (assoc param-symbol aurel-pacman-param-alist)))
(defun aurel-get-pacman-param-symbol (param-name)
"Return a symbol name of a parameter.
PARAM-NAME is a string from `aurel-pacman-param-alist'."
(car (rassoc param-name aurel-pacman-param-alist)))
;;; Filters for processing package info
(defvar aurel-filter-params nil
"List of parameters (symbols), that should match specified strings.
Used in `aurel-filter-contains-every-string'.")
(defvar aurel-filter-strings nil
"List of strings, a package info should match.
Used in `aurel-filter-contains-every-string'.")
(defvar aurel-aur-filters
'(aurel-aur-filter-intern
aurel-filter-contains-every-string
aurel-filter-pkg-url)
"List of filter functions applied to a package info got from AUR.
Each filter function should accept a single argument - info alist
with package parameters and should return info alist or
nil (which means: ignore this package info). Functions may
modify associations or add the new ones to the alist. In the
latter case you might want to add descriptions of the added
symbols into `aurel-titles'.
`aurel-aur-filter-intern' should be the first symbol in the list as
other filters use symbols for working with info parameters (see
`aurel-aur-param-alist').
For more information, see `aurel-receive-packages-info'.")
(defvar aurel-pacman-filters
'(aurel-pacman-filter-intern
aurel-pacman-filter-none)
"List of filter functions applied to a package info got from pacman.
`aurel-pacman-filter-intern' should be the first symbol in the list as
other filters use symbols for working with info parameters (see
`aurel-pacman-param-alist').
For more information, see `aurel-aur-filters' and
`aurel-receive-packages-info'.")
(defvar aurel-final-filters
'()
"List of filter functions applied to a package info.
For more information, see `aurel-receive-packages-info'.")
(defun aurel-apply-filters (info filters)
"Apply functions from FILTERS list to a package INFO.
INFO is alist with package parameters. It is passed as an
argument to the first function from FILTERS, the returned result
is passed to the second function from that list and so on.
Return filtered info (result of the last filter). Return nil, if
one of the FILTERS returns nil (do not call the rest filters)."
(cl-loop for fun in filters
do (setq info (funcall fun info))
while info
finally return info))
(defun aurel-filter-intern (info param-fun &optional warning)
"Replace names of parameters with symbols in a package INFO.
INFO is alist of parameter names (strings) and values.
PARAM-FUN is a function for getting parameter internal symbol by
its name (string).
If WARNING is non-nil, show a message if unknown parameter is found.
Return modified info."
(delq nil
(mapcar
(-lambda ((param-name . param-val))
(let ((param-symbol (funcall param-fun param-name)))
(if param-symbol
(cons param-symbol param-val)
(when warning
(message "\
Warning: unknown parameter '%s'. It will be omitted."
param-name))
nil)))
info)))
(defun aurel-aur-filter-intern (info)
"Replace names of parameters with symbols in a package INFO.
INFO is alist of parameter names (strings) from
`aurel-aur-param-alist' and their values.
Return modified info."
(aurel-filter-intern info 'aurel-get-aur-param-symbol t))
(defun aurel-pacman-filter-intern (info)
"Replace names of parameters with symbols in a package INFO.
INFO is alist of parameter names (strings) from
`aurel-pacman-param-alist' and their values.
Return modified info."
(aurel-filter-intern info 'aurel-get-pacman-param-symbol))
(defun aurel-pacman-filter-none (info)
"Replace `aurel-none-string' values in pacman INFO with nil."
(mapcar (-lambda ((name . val))
(cons name
(unless (string= val aurel-none-string) val)))
info))
(defun aurel-filter-contains-every-string (info)
"Check if a package INFO contains all necessary strings.
Return INFO, if values of parameters from `aurel-filter-params'
contain all strings from `aurel-filter-strings', otherwise return nil.
Pass the check (return INFO), if `aurel-filter-strings' or
`aurel-filter-params' is nil."
(when (or (null aurel-filter-params)
(null aurel-filter-strings)
(let ((str (mapconcat (lambda (param)
(bui-entry-value info param))
aurel-filter-params
"\n")))
(cl-every (lambda (substr)
(string-match-p (regexp-quote substr) str))
aurel-filter-strings)))
info))
(defun aurel-filter-pkg-url (info)
"Update `pkg-url' parameter in a package INFO.
INFO is alist of parameter symbols and values.
Return modified info."
(let ((param (assoc 'pkg-url info)))
(setcdr param (url-expand-file-name (cdr param) aurel-aur-base-url)))
info)
;;; Searching/showing packages
(defun aurel-receive-packages-info (url)
"Return information about the packages from URL.
Information is received with `aurel-get-aur-packages-info', then
it is passed through `aurel-aur-filters' with
`aurel-apply-filters'. If `aurel-installed-packages-check' is
non-nil, additional information about installed packages is
received with `aurel-get-installed-packages-info' and is passed
through `aurel-installed-filters'. Finally packages info is passed
through `aurel-final-filters'.
Returning value is alist of (ID . PACKAGE-ALIST) entries."
;; To speed-up the process, pacman should be called once with the
;; names of found packages (instead of calling it for each name). So
;; we need to know the names at first, that's why we don't use a
;; single filters variable: at first we filter info received from AUR,
;; then we add information about installed packages from pacman and
;; finally filter the whole info.
(let (aur-info-list aur-info-alist
pac-info-list pac-info-alist
info-list)
;; Receive and process information from AUR server
(setq aur-info-list (aurel-get-aur-packages-info url)
aur-info-alist (aurel-get-filtered-alist
aur-info-list aurel-aur-filters 'name))
;; Receive and process information from pacman
(when aurel-installed-packages-check
(setq pac-info-list (apply 'aurel-get-installed-packages-info
(mapcar #'car aur-info-alist))
pac-info-alist (aurel-get-filtered-alist
pac-info-list
aurel-pacman-filters
'installed-name)))
;; Join info and do final processing
(setq info-list
(mapcar (lambda (aur-info-assoc)
(let* ((name (car aur-info-assoc))
(pac-info-assoc (assoc name pac-info-alist)))
(append (cdr aur-info-assoc)
(cdr pac-info-assoc))))
aur-info-alist))
(aurel-get-filtered-alist info-list aurel-final-filters 'id)))
(defun aurel-get-filtered-alist (info-list filters param)
"Return alist with filtered packages info.
INFO-LIST is a list of packages info. Each info is passed through
FILTERS with `aurel-apply-filters'.
Each association of a returned value has a form:
(PARAM-VAL . INFO)
PARAM-VAL is a value of a parameter PARAM.
INFO is a filtered package info."
(delq nil ; ignore filtered (empty) info
(mapcar (lambda (info)
(let ((info (aurel-apply-filters info filters)))
(and info
(cons (bui-entry-value info param) info))))
info-list)))
(defun aurel-get-packages-by-name (&rest names)
"Return packages by package NAMES (list of strings)."
(aurel-receive-packages-info
(apply #'aurel-get-package-info-url names)))
(defun aurel-get-packages-by-string (&rest strings)
"Return packages matching STRINGS."
;; A hack for searching by multiple strings: the actual server search
;; is done by the biggest string and the rest strings are searched in
;; the results returned by the server
(let* ((str-list
;; sort to search by the biggest (first) string
(sort strings
(lambda (a b)
(> (length a) (length b)))))
(aurel-filter-params '(name description))
(aurel-filter-strings (cdr str-list)))
(aurel-receive-packages-info
(aurel-get-package-search-url (car str-list)))))
(defun aurel-get-packages-by-name-string (string)
"Return packages with name containing STRING."
(aurel-receive-packages-info
(aurel-get-package-name-search-url string)))
(defun aurel-get-packages-by-maintainer (name)
"Return packages by maintainer NAME."
(aurel-receive-packages-info
(aurel-get-maintainer-search-url name)))
(defvar aurel-search-type-alist
'((name . aurel-get-packages-by-name)
(string . aurel-get-packages-by-string)
(name-string . aurel-get-packages-by-name-string)
(maintainer . aurel-get-packages-by-maintainer))
"Alist of available search types and search functions.")
(defun aurel-search-packages (type &rest vals)
"Search for AUR packages and return results.
TYPE is a type of search - symbol from `aurel-search-type-alist'.
It defines a search function which is called with VALS as
arguments."
(let ((fun (cdr (assoc type aurel-search-type-alist))))
(or fun
(error "Wrong search type '%s'" type))
(apply fun vals)))
(defun aurel-search-packages-with-user-info (type &rest vals)
"Search for AUR packages and return results.
This is like `aurel-search-packages' but also add AUR user info
depending on `aurel-aur-user-package-info-check'."
(let ((entries (apply #'aurel-search-packages type vals)))
(if aurel-aur-user-package-info-check
(mapcar #'aurel-add-aur-user-package-info entries)
entries)))
(defun aurel-search-show-packages (search-type &rest search-vals)
"Search for packages and show results.
See `aurel-search-packages' for the meaning of SEARCH-TYPE and
SEARCH-VALS."
(apply #'bui-list-get-display-entries
'aurel search-type search-vals))
(defvar aurel-found-messages
'((name (0 "The package \"%s\" not found." "Packages not found.")
(1 "The package \"%s\"."))
(string (0 "No packages matching %s.")
(1 "A single package matching %s.")
(many "%d packages matching %s."))
(maintainer (0 "No packages by maintainer %s.")
(1 "A single package by maintainer %s.")
(many "%d packages by maintainer %s.")))
"Alist used by `aurel-found-message'.")
(defun aurel-found-message (packages search-type &rest search-vals)
"Display a proper message about found PACKAGES.
SEARCH-TYPE and SEARCH-VALS are arguments for
`aurel-search-packages', by which the PACKAGES were found."
(let* ((count (length packages))
(found-key (if (> count 1) 'many count))
(type-alist (cdr (assoc search-type aurel-found-messages)))
(found-list (cdr (assoc found-key type-alist)))
(msg (if (or (= 1 (length search-vals))
(null (cdr found-list)))
(car found-list)
(cadr found-list)))
(args (delq nil
(list
(and (eq found-key 'many) count)
(cond
((eq search-type 'string)
(mapconcat (lambda (str) (concat "\"" str "\""))
search-vals " "))
((and (= count 1) (eq search-type 'name))
(bui-entry-value (cdar packages) 'name))
(t (car search-vals)))))))
(and msg (apply 'message msg args))))
;;; Downloading
(defcustom aurel-download-directory temporary-file-directory
"Default directory for downloading AUR packages."
:type 'directory
:group 'aurel)
(defcustom aurel-directory-prompt "Download to: "
"Default directory prompt for downloading AUR packages."
:type 'string
:group 'aurel)
(defvar aurel-download-functions
'(aurel-download aurel-download-unpack aurel-download-unpack-dired
aurel-download-unpack-pkgbuild aurel-download-unpack-eshell)
"List of available download functions.")
(defun aurel-read-download-directory ()
"Return `aurel-download-directory' or prompt for it.
This function is intended for using in `interactive' forms."
(if current-prefix-arg
(read-directory-name aurel-directory-prompt
aurel-download-directory)
aurel-download-directory))
(defun aurel-download-get-defcustom-type ()
"Return `defcustom' type for selecting a download function."
`(radio ,@(mapcar (lambda (fun) (list 'function-item fun))
aurel-download-functions)
(function :tag "Other function")))
(defun aurel-download (url dir)
"Download AUR package from URL to a directory DIR.
Return a path to the downloaded file."
;; Is there a simpler way to download a file?
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
(with-temp-buffer
(insert-file-contents-literally url)
(let ((file (expand-file-name (url-file-nondirectory url) dir)))
(write-file file)
file))))
;; Code for working with `tar-mode' came from `package-untar-buffer'
;; Avoid compilation warnings about tar functions and variables
(defvar tar-parse-info)
(defvar tar-data-buffer)
(declare-function tar-untar-buffer "tar-mode" ())
(declare-function tar-header-name "tar-mode" (tar-header) t)
(declare-function tar-header-link-type "tar-mode" (tar-header) t)
(defun aurel-tar-subdir (tar-info)
"Return directory name where files from TAR-INFO will be extracted."
(let* ((first-header (car tar-info))
(first-header-type (tar-header-link-type first-header)))
(cl-case first-header-type
(55 ; pax_global_header
;; There are other special headers (see `tar--check-descriptor', for
;; example). Should they also be ignored?
(aurel-tar-subdir (cdr tar-info)))
(5 ; directory
(let* ((dir-name (tar-header-name first-header))
(dir-re (regexp-quote dir-name)))
(dolist (tar-data (cdr tar-info))
(or (string-match dir-re (tar-header-name tar-data))
(error (concat "Not all files are going to be extracted"
" into directory '%s'")
dir-name)))
dir-name))
(t
(error "The first entry '%s' in tar file is not a directory"
(tar-header-name first-header))))))
(defun aurel-download-unpack (url dir)
"Download AUR package from URL and unpack it into a directory DIR.
Use `tar-untar-buffer' from Tar mode. All files should be placed
in one directory; otherwise, signal an error.
Return a path to the unpacked directory."
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
(with-temp-buffer
(insert-file-contents url)
(setq default-directory dir)