aurel.el 93 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552
  1. ;;; aurel.el --- Search, get info, vote and download AUR packages -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2014, 2015, 2016 Alex Kost
  3. ;; Author: Alex Kost <alezost@gmail.com>
  4. ;; Created: 6 Feb 2014
  5. ;; Version: 0.8
  6. ;; URL: https://github.com/alezost/aurel
  7. ;; Keywords: tools
  8. ;; Package-Requires: ((emacs "24.3"))
  9. ;; This program is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; The package provides an interface for searching, getting information,
  21. ;; voting, subscribing and downloading packages from the Arch User
  22. ;; Repository (AUR) <https://aur.archlinux.org/>.
  23. ;; To manually install the package, add the following to your init-file:
  24. ;;
  25. ;; (add-to-list 'load-path "/path/to/aurel-dir")
  26. ;; (autoload 'aurel-package-info "aurel" nil t)
  27. ;; (autoload 'aurel-package-search "aurel" nil t)
  28. ;; (autoload 'aurel-package-search-by-name "aurel" nil t)
  29. ;; (autoload 'aurel-maintainer-search "aurel" nil t)
  30. ;; (autoload 'aurel-installed-packages "aurel" nil t)
  31. ;; Also set a directory where downloaded packages will be put:
  32. ;;
  33. ;; (setq aurel-download-directory "~/aur")
  34. ;; To search for packages, use `aurel-package-search' or
  35. ;; `aurel-maintainer-search' commands. If you know the name of a
  36. ;; package, use `aurel-package-info' command. Also you can display a
  37. ;; list of installed AUR packages with `aurel-installed-packages'.
  38. ;; Information about the packages is represented in a list-like buffer
  39. ;; similar to a buffer containing emacs packages. To get more info
  40. ;; about a package, press "RET" on a package line. To download a
  41. ;; package, press "d" (don't forget to set `aurel-download-directory'
  42. ;; before). In a list buffer, you can mark several packages for
  43. ;; downloading with "m"/"M" (and unmark with "u"/"U" and "DEL"); also
  44. ;; you can perform filtering (press "f f" to enable a filter and "f d"
  45. ;; to disable all filters) of a current list to hide particular
  46. ;; packages.
  47. ;; It is possible to move to the previous/next displayed results with
  48. ;; "l"/"r" (each aurel buffer has its own history) and to refresh
  49. ;; information with "g".
  50. ;; After receiving information about the packages, pacman is called to
  51. ;; find what packages are installed. To disable that, set
  52. ;; `aurel-installed-packages-check' to nil.
  53. ;; To vote/subscribe for a package, press "v"/"s" (with prefix
  54. ;; unvote/unsubscribe) in a package info buffer (you should have an AUR
  55. ;; account for that). To add information about "Voted"/"Subscribed"
  56. ;; status, use the following:
  57. ;;
  58. ;; (setq aurel-aur-user-package-info-check t)
  59. ;; For full description and screenshots, see
  60. ;; <https://github.com/alezost/aurel>.
  61. ;;; Code:
  62. (require 'url)
  63. (require 'url-handlers)
  64. (require 'json)
  65. (require 'tabulated-list)
  66. (require 'cl-lib)
  67. (defgroup aurel nil
  68. "Search and download AUR (Arch User Repository) packages."
  69. :group 'applications)
  70. (defcustom aurel-empty-string "-"
  71. "String used for empty (or none) values of package parameters."
  72. :type 'string
  73. :group 'aurel)
  74. (defcustom aurel-true-string "Yes"
  75. "String used if a parameter value is t."
  76. :type 'string
  77. :group 'aurel)
  78. (defcustom aurel-false-string "No"
  79. "String used if a parameter value is nil."
  80. :type 'string
  81. :group 'aurel)
  82. (defcustom aurel-date-format "%Y-%m-%d %T"
  83. "Time format used to represent time parameters of a package.
  84. For information about time formats, see `format-time-string'."
  85. :type 'string
  86. :group 'aurel)
  87. (defcustom aurel-list-single-package nil
  88. "If non-nil, list a package even if it is the one matching result.
  89. If nil, show a single matching package in info buffer."
  90. :type 'boolean
  91. :group 'aurel)
  92. (defcustom aurel-aur-user-package-info-check nil
  93. "If non-nil, check additional info before displaying a package info.
  94. Additional info is an AUR user specific information (whether the user
  95. voted for the package or subscribed to receive comments)."
  96. :type 'boolean
  97. :group 'aurel)
  98. (defvar aurel-unknown-string "Unknown"
  99. "String used if a value of the parameter is unknown.")
  100. (defvar aurel-none-string "None"
  101. "String saying that a parameter has no value.
  102. This string can be displayed by pacman.")
  103. (defvar aurel-package-name-re
  104. "[-+_[:alnum:]]+"
  105. "Regexp matching a valid package name.")
  106. (defvar aurel-list-separator ", ")
  107. (defun aurel-get-string (val &optional face)
  108. "Return string from VAL.
  109. If VAL is `aurel-none-string' return `aurel-empty-string'.
  110. If VAL is nil, return `aurel-false-string'.
  111. If VAL is t, return `aurel-true-string'.
  112. If VAL is a number, use `number-to-string'.
  113. If VAL is a time value, format it with `aurel-date-format'.
  114. If VAL is a list, separate its values with `aurel-list-separator'.
  115. Otherwise, if VAL is not string, use `prin1-to-string'.
  116. If FACE is non-nil, propertize returned string with this FACE."
  117. (if (equal val aurel-none-string)
  118. aurel-empty-string
  119. (let ((str (cond
  120. ((stringp val) val)
  121. ((null val) aurel-false-string)
  122. ((eq t val) aurel-true-string)
  123. ((numberp val) (number-to-string val))
  124. ((aurel-time-p val)
  125. (format-time-string aurel-date-format val))
  126. ((listp val)
  127. (mapconcat #'aurel-get-string
  128. val aurel-list-separator))
  129. (t (prin1-to-string val)))))
  130. (if (and val face)
  131. (propertize str 'face face)
  132. str))))
  133. (defun aurel-time-p (val)
  134. "Return non-nil, if VAL is a time value; return nil otherwise."
  135. (condition-case nil
  136. (decode-time val)
  137. (error nil)))
  138. ;;; Debugging
  139. (defvar aurel-debug-level 0
  140. "If > 0, display debug messages in `aurel-debug-buffer'.
  141. The greater the number, the more messages is printed.
  142. Max level is 9.")
  143. (defvar aurel-debug-buffer "*aurel debug*"
  144. "Name of a buffer containing debug messages.")
  145. (defvar aurel-debug-time-format "%T.%3N"
  146. "Time format used for debug mesages.")
  147. (defun aurel-debug (level msg &rest args)
  148. "Print debug message if needed.
  149. If `aurel-debug-level' >= LEVEL, print debug message MSG with
  150. arguments ARGS into `aurel-debug-buffer'.
  151. Return nil."
  152. (when (>= aurel-debug-level level)
  153. (with-current-buffer (get-buffer-create aurel-debug-buffer)
  154. (goto-char (point-max))
  155. (insert (format-time-string aurel-debug-time-format (current-time)))
  156. (insert " " (apply 'format msg args) "\n")))
  157. nil)
  158. ;;; Interacting with AUR server
  159. (defcustom aurel-aur-user-name ""
  160. "User name for AUR."
  161. :type 'string
  162. :group 'aurel)
  163. (defvar aurel-aur-host "aur.archlinux.org"
  164. "AUR domain.")
  165. (defvar aurel-aur-base-url (concat "https://" aurel-aur-host)
  166. "Root URL of the AUR service.")
  167. (defvar aurel-aur-login-url
  168. (url-expand-file-name "login" aurel-aur-base-url)
  169. "Login URL.")
  170. (defconst aurel-aur-cookie-name "AURSID"
  171. "Cookie name used for AUR login.")
  172. ;; Avoid compilation warning about `url-http-response-status'
  173. (defvar url-http-response-status)
  174. (defun aurel-check-response-status (buffer &optional noerror)
  175. "Return t, if URL response status in BUFFER is 2XX or 3XX.
  176. Otherwise, throw an error or return nil, if NOERROR is nil."
  177. (with-current-buffer buffer
  178. (aurel-debug 3 "Response status: %s" url-http-response-status)
  179. (if (or (null (numberp url-http-response-status))
  180. (> url-http-response-status 399))
  181. (unless noerror (error "Error during request: %s"
  182. url-http-response-status))
  183. t)))
  184. (defun aurel-receive-parse-info (url)
  185. "Return received output from URL processed with `json-read'."
  186. (aurel-debug 3 "Retrieving %s" url)
  187. (with-temp-buffer
  188. (url-insert-file-contents url)
  189. (goto-char (point-min))
  190. (let ((json-key-type 'string)
  191. (json-array-type 'list)
  192. (json-object-type 'alist))
  193. (json-read))))
  194. (defun aurel-get-aur-packages-info (url)
  195. "Return information about the packages from URL.
  196. Output from URL should be a json data. It is parsed with
  197. `json-read'.
  198. Returning value is alist of AUR package parameters (strings from
  199. `aurel-aur-param-alist') and their values."
  200. (let* ((full-info (aurel-receive-parse-info url))
  201. (type (cdr (assoc "type" full-info)))
  202. (count (cdr (assoc "resultcount" full-info)))
  203. (results (cdr (assoc "results" full-info))))
  204. (cond
  205. ((string= type "error")
  206. (error "%s" results))
  207. ((= count 0)
  208. nil)
  209. (t
  210. (when (string= type "info")
  211. (setq results (list results)))
  212. results))))
  213. ;; Because of the bug <http://bugs.gnu.org/16960>, we can't use
  214. ;; `url-retrieve-synchronously' (or any other simple call of
  215. ;; `url-retrieve', as the callback is never called) to login to
  216. ;; <https://aur.archlinux.org>. So we use
  217. ;; `aurel-url-retrieve-synchronously' - it is almost the same, except it
  218. ;; can exit from the waiting loop when a buffer with received data
  219. ;; appears in `url-dead-buffer-list'. This hack is currently possible,
  220. ;; because `url-http-parse-headers' marks the buffer as dead when it
  221. ;; returns nil.
  222. (defun aurel-url-retrieve-synchronously (url &optional silent inhibit-cookies)
  223. "Retrieve URL synchronously.
  224. Return the buffer containing the data, or nil if there are no data
  225. associated with it (the case for dired, info, or mailto URLs that need
  226. no further processing). URL is either a string or a parsed URL.
  227. See `url-retrieve' for SILENT and INHIBIT-COOKIES."
  228. (url-do-setup)
  229. (let (asynch-buffer retrieval-done)
  230. (setq asynch-buffer
  231. (url-retrieve url
  232. (lambda (&rest ignored)
  233. (url-debug 'retrieval
  234. "Synchronous fetching done (%S)"
  235. (current-buffer))
  236. (setq retrieval-done t
  237. asynch-buffer (current-buffer)))
  238. nil silent inhibit-cookies))
  239. (when asynch-buffer
  240. (let ((proc (get-buffer-process asynch-buffer)))
  241. (while (not (or retrieval-done
  242. ;; retrieval can be done even if
  243. ;; `retrieval-done' is nil (see the comment
  244. ;; above)
  245. (memq asynch-buffer url-dead-buffer-list)))
  246. (url-debug 'retrieval
  247. "Spinning in url-retrieve-synchronously: %S (%S)"
  248. retrieval-done asynch-buffer)
  249. (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
  250. (setq proc (get-buffer-process
  251. (setq asynch-buffer
  252. (buffer-local-value 'url-redirect-buffer
  253. asynch-buffer))))
  254. (if (and proc (memq (process-status proc)
  255. '(closed exit signal failed))
  256. ;; Make sure another process hasn't been started.
  257. (eq proc (or (get-buffer-process asynch-buffer) proc)))
  258. (progn ;; Call delete-process so we run any sentinel now.
  259. (delete-process proc)
  260. (setq retrieval-done t)))
  261. (unless (or (with-local-quit
  262. (accept-process-output proc))
  263. (null proc))
  264. (when quit-flag
  265. (delete-process proc))
  266. (setq proc (and (not quit-flag)
  267. (get-buffer-process asynch-buffer)))))))
  268. asynch-buffer)))
  269. (defun aurel-url-post (url args &optional inhibit-cookies)
  270. "Send ARGS to URL as a POST request.
  271. ARGS is alist of field names and values to send.
  272. Return the buffer with the received data.
  273. If INHIBIT-COOKIES is non-nil, do not use saved cookies."
  274. (let ((url-request-method "POST")
  275. (url-request-extra-headers
  276. '(("Content-Type" . "application/x-www-form-urlencoded")))
  277. (url-request-data (aurel-get-fields-string args)))
  278. (aurel-debug 2 "POSTing to %s" url)
  279. (aurel-url-retrieve-synchronously url inhibit-cookies)))
  280. (defun aurel-get-aur-cookie ()
  281. "Return cookie for AUR login.
  282. Return nil, if there is no such cookie or it is expired."
  283. (url-do-setup) ; initialize cookies
  284. (let* ((cookies (url-cookie-retrieve aurel-aur-host "/" t))
  285. (cookie (car (cl-member-if
  286. (lambda (cookie)
  287. (equal (url-cookie-name cookie)
  288. aurel-aur-cookie-name))
  289. cookies))))
  290. (if (null cookie)
  291. (aurel-debug 4 "AUR login cookie not found")
  292. (if (url-cookie-expired-p cookie)
  293. (aurel-debug 4 "AUR login cookie is expired")
  294. (aurel-debug 4 "AUR login cookie is valid")
  295. cookie))))
  296. (declare-function auth-source-search "auth-source" t)
  297. (defun aurel-aur-login-maybe (&optional force noerror)
  298. "Login to AUR, use cookie if possible.
  299. If FORCE is non-nil (interactively, with prefix), prompt for
  300. credentials and login without trying the cookie.
  301. See `aurel-aur-login' for the meaning of NOERROR and returning value."
  302. (interactive "P")
  303. (if (aurel-get-aur-cookie)
  304. (progn
  305. (aurel-debug 2 "Using cookie instead of a real login")
  306. t)
  307. (let (user password)
  308. (let ((auth (car (auth-source-search :host aurel-aur-host))))
  309. (when auth
  310. (let ((secret (plist-get auth :secret)))
  311. (setq user (plist-get auth :user)
  312. password (if (functionp secret)
  313. (funcall secret)
  314. secret)))))
  315. (when (or force (null user))
  316. (setq user (read-string "AUR user name: " aurel-aur-user-name)))
  317. (when (or force (null password))
  318. (setq password (read-passwd "Password: ")))
  319. (aurel-aur-login user password t noerror))))
  320. (defun aurel-aur-login (user password &optional remember noerror)
  321. "Login to AUR with USER and PASSWORD.
  322. If REMEMBER is non-nil, remember a cookie.
  323. Return t, if login was successful, otherwise throw an error or
  324. return nil, if NOERROR is non-nil."
  325. (let ((buf (aurel-url-post
  326. aurel-aur-login-url
  327. (list (cons "user" user)
  328. (cons "passwd" password)
  329. (cons "remember_me" (if remember "on" "off")))
  330. 'inhibit-cookie)))
  331. (when (aurel-check-response-status buf noerror)
  332. (with-current-buffer buf
  333. (if (re-search-forward "errorlist.+<li>\\(.+\\)</li>" nil t)
  334. (let ((err (match-string 1)))
  335. (aurel-debug 1 "Error during login: %s" )
  336. (or noerror (error "%s" err))
  337. nil)
  338. (url-cookie-write-file)
  339. (aurel-debug 1 "Login for %s is successful" user)
  340. t)))))
  341. (defun aurel-add-aur-user-package-info (info)
  342. "Append additional info to a package INFO.
  343. INFO should have a form of `aurel-info'.
  344. See `aurel-aur-user-package-info-check' for the meaning of
  345. additional info."
  346. (let ((add (aurel-get-aur-user-package-info
  347. (aurel-get-aur-package-url
  348. (aurel-get-param-val 'name info)))))
  349. (when add
  350. (setcdr (last info) add))))
  351. (defun aurel-get-aur-user-package-info (url)
  352. "Return AUR user specific information about a package from URL.
  353. Returning value is alist of package parameters specific for AUR
  354. user (`voted' and `subscribed') and their values.
  355. Return nil, if information is not found."
  356. (when (aurel-aur-login-maybe nil t)
  357. (aurel-debug 3 "Retrieving %s" url)
  358. (let ((buf (url-retrieve-synchronously url)))
  359. (aurel-debug 4 "Searching in %S for voted/subscribed params" buf)
  360. (list (cons 'voted
  361. (aurel-aur-package-voted buf))
  362. (cons 'subscribed
  363. (aurel-aur-package-subscribed buf))))))
  364. (defun aurel-aur-package-voted (buffer)
  365. "Return `voted' parameter value from BUFFER with fetched data.
  366. Return non-nil if a package is voted by the user; nil if it is not;
  367. `aurel-unknown-string' if the information is not found.
  368. BUFFER should contain html data about the package."
  369. (cond
  370. ((aurel-search-in-buffer
  371. (aurel-get-aur-user-action-name 'vote) buffer)
  372. nil)
  373. ((aurel-search-in-buffer
  374. (aurel-get-aur-user-action-name 'unvote) buffer)
  375. t)
  376. (t aurel-unknown-string)))
  377. (defun aurel-aur-package-subscribed (buffer)
  378. "Return `subscribed' parameter value from BUFFER with fetched data.
  379. Return non-nil if a package is subscribed by the user; nil if it is not;
  380. `aurel-unknown-string' if the information is not found.
  381. BUFFER should contain html data about the package."
  382. (cond
  383. ((aurel-search-in-buffer
  384. (aurel-get-aur-user-action-name 'subscribe) buffer)
  385. nil)
  386. ((aurel-search-in-buffer
  387. (aurel-get-aur-user-action-name 'unsubscribe) buffer)
  388. t)
  389. (t aurel-unknown-string)))
  390. (defun aurel-search-in-buffer (regexp buffer)
  391. "Return non-nil if BUFFER contains REGEXP; return nil otherwise."
  392. (with-current-buffer buffer
  393. (goto-char (point-min))
  394. (let ((res (re-search-forward regexp nil t)))
  395. (aurel-debug 7 "Searching for %s in %S: %S" regexp buffer res)
  396. res)))
  397. (defvar aurel-aur-user-actions
  398. '((vote "do_Vote" "vote" "Vote for the current package?")
  399. (unvote "do_UnVote" "unvote" "Do you really want to unvote?")
  400. (subscribe "do_Notify" "notify" "Subscribe to the new comments?")
  401. (unsubscribe "do_UnNotify" "unnotify" "Unsubscribe from notifying about the new comments?"))
  402. "Alist of the available actions.
  403. Each association has the following form:
  404. (SYMBOL NAME URL-END CONFIRM)
  405. SYMBOL is a name of the action used internally in code of this package.
  406. NAME is a name (string) used in the html-code of AUR package page.
  407. URL-END is appended to the package URL; used for posting the action.
  408. CONFIRM is a prompt to confirm the action or nil if it is not required.")
  409. (defun aurel-get-aur-user-action-name (action)
  410. "Return the name of an ACTION."
  411. (cadr (assoc action aurel-aur-user-actions)))
  412. (defun aurel-aur-user-action (action package-base)
  413. "Perform AUR user ACTION on the PACKAGE-BASE.
  414. ACTION is a symbol from `aurel-aur-user-actions'.
  415. PACKAGE-BASE is a name of the package base (string).
  416. Return non-nil, if ACTION was performed; return nil otherwise."
  417. (let ((assoc (assoc action aurel-aur-user-actions)))
  418. (let ((action-name (nth 1 assoc))
  419. (url-end (nth 2 assoc))
  420. (confirm (nth 3 assoc)))
  421. (when (or (null confirm)
  422. (y-or-n-p confirm))
  423. (aurel-aur-login-maybe)
  424. (aurel-url-post
  425. (aurel-get-package-action-url package-base url-end)
  426. (list (cons "token" (url-cookie-value (aurel-get-aur-cookie)))
  427. (cons action-name "")))
  428. t))))
  429. ;;; Interacting with pacman
  430. (defcustom aurel-pacman-program (executable-find "pacman")
  431. "Absolute or relative name of `pacman' program."
  432. :type 'string
  433. :group 'aurel)
  434. (defvar aurel-pacman-locale "C"
  435. "Default locale used to start pacman.")
  436. (defcustom aurel-installed-packages-check
  437. (and aurel-pacman-program t)
  438. "If non-nil, check if the found packages are installed.
  439. If nil, searching works faster, because `aurel-pacman-program' is not
  440. called, but it stays unknown if a package is installed or not."
  441. :type 'boolean
  442. :group 'aurel)
  443. (defvar aurel-pacman-buffer-name " *aurel-pacman*"
  444. "Name of the buffer used internally for pacman output.")
  445. (defvar aurel-pacman-info-line-re
  446. (rx line-start
  447. (group (+? (any word " ")))
  448. (+ " ") ":" (+ " ")
  449. (group (+ any) (* (and "\n " (+ any))))
  450. line-end)
  451. "Regexp matching a line of pacman query info output.
  452. Contain 2 parenthesized groups: parameter name and its value.")
  453. (defun aurel-call-pacman (&optional buffer &rest args)
  454. "Call `aurel-pacman-program' with arguments ARGS.
  455. Insert output in BUFFER. If it is nil, use `aurel-pacman-buffer-name'.
  456. Return numeric exit status."
  457. (or aurel-pacman-program
  458. (error (concat "Couldn't find pacman.\n"
  459. "Set aurel-pacman-program to a proper value")))
  460. (with-current-buffer
  461. (or buffer (get-buffer-create aurel-pacman-buffer-name))
  462. (erase-buffer)
  463. (let ((process-environment
  464. (cons (concat "LC_ALL=" aurel-pacman-locale)
  465. process-environment)))
  466. (apply #'call-process aurel-pacman-program nil t nil args))))
  467. (defun aurel-get-foreign-packages ()
  468. "Return list of names of installed foreign packages."
  469. (let ((buf (get-buffer-create aurel-pacman-buffer-name)))
  470. (aurel-call-pacman buf "--query" "--foreign")
  471. (aurel-pacman-query-names-buffer-parse buf)))
  472. (defun aurel-pacman-query-names-buffer-parse (&optional buffer)
  473. "Parse BUFFER with packages names.
  474. BUFFER should contain an output returned by 'pacman -Q' command.
  475. If BUFFER is nil, use `aurel-pacman-buffer-name'.
  476. Return list of names of packages."
  477. (with-current-buffer
  478. (or buffer (get-buffer-create aurel-pacman-buffer-name))
  479. (goto-char (point-min))
  480. (let (names)
  481. (while (re-search-forward
  482. (concat "^\\(" aurel-package-name-re "\\) ") nil t)
  483. (setq names (cons (match-string 1) names)))
  484. names)))
  485. (defun aurel-get-installed-packages-info (&rest names)
  486. "Return information about installed packages NAMES.
  487. Each name from NAMES should be a string (a name of a package).
  488. Returning value is a list of alists with installed package
  489. parameters (strings from `aurel-installed-param-alist') and their
  490. values."
  491. (let ((buf (get-buffer-create aurel-pacman-buffer-name)))
  492. (apply 'aurel-call-pacman buf "--query" "--info" names)
  493. (aurel-pacman-query-buffer-parse buf)))
  494. (defun aurel-pacman-query-buffer-parse (&optional buffer)
  495. "Parse BUFFER with packages info.
  496. BUFFER should contain an output returned by 'pacman -Qi' command.
  497. If BUFFER is nil, use `aurel-pacman-buffer-name'.
  498. Return list of alists with parameter names and values."
  499. (with-current-buffer
  500. (or buffer (get-buffer-create aurel-pacman-buffer-name))
  501. (let ((beg (point-min))
  502. end info)
  503. ;; Packages info are separated with empty lines, search for those
  504. ;; till the end of buffer
  505. (cl-loop
  506. do (progn
  507. (goto-char beg)
  508. (setq end (re-search-forward "^\n" nil t))
  509. (and end
  510. (setq info (aurel-pacman-query-region-parse beg end)
  511. beg end)))
  512. while end
  513. if info collect info))))
  514. (defun aurel-pacman-query-region-parse (beg end)
  515. "Parse text (package info) in current buffer from BEG to END.
  516. Parsing region should be an output for one package returned by
  517. 'pacman -Qi' command.
  518. Return alist with parameter names and values."
  519. (goto-char beg)
  520. (let (point)
  521. (cl-loop
  522. do (setq point (re-search-forward
  523. aurel-pacman-info-line-re end t))
  524. while point
  525. collect (cons (match-string 1) (match-string 2)))))
  526. ;;; Package parameters
  527. (defvar aurel-aur-param-alist
  528. '((pkg-url . "URLPath")
  529. (home-url . "URL")
  530. (last-date . "LastModified")
  531. (first-date . "FirstSubmitted")
  532. (outdated . "OutOfDate")
  533. (votes . "NumVotes")
  534. (popularity . "Popularity")
  535. (license . "License")
  536. (description . "Description")
  537. (keywords . "Keywords")
  538. (version . "Version")
  539. (name . "Name")
  540. (id . "ID")
  541. (base-name . "PackageBase")
  542. (base-id . "PackageBaseID")
  543. (maintainer . "Maintainer")
  544. (replaces . "Replaces")
  545. (provides . "Provides")
  546. (conflicts . "Conflicts")
  547. (depends . "Depends")
  548. (depends-make . "MakeDepends"))
  549. "Association list of symbols and names of package info parameters.
  550. Car of each assoc is a symbol used in code of this package.
  551. Cdr - is a parameter name (string) returned by the AUR server.")
  552. (defvar aurel-pacman-param-alist
  553. '((installed-name . "Name")
  554. (installed-version . "Version")
  555. (architecture . "Architecture")
  556. (installed-provides . "Provides")
  557. (installed-depends . "Depends On")
  558. (depends-opt . "Optional Deps")
  559. (script . "Install Script")
  560. (reason . "Install Reason")
  561. (validated . "Validated By")
  562. (required . "Required By")
  563. (optional-for . "Optional For")
  564. (installed-conflicts . "Conflicts With")
  565. (installed-replaces . "Replaces")
  566. (installed-size . "Installed Size")
  567. (packager . "Packager")
  568. (build-date . "Build Date")
  569. (install-date . "Install Date"))
  570. "Association list of symbols and names of package info parameters.
  571. Car of each assoc is a symbol used in code of this package.
  572. Cdr - is a parameter name (string) returned by pacman.")
  573. (defvar aurel-param-description-alist
  574. '((pkg-url . "Download URL")
  575. (home-url . "Home Page")
  576. (aur-url . "AUR Page")
  577. (base-url . "Package Base")
  578. (last-date . "Last Modified")
  579. (first-date . "Submitted")
  580. (outdated . "Out Of Date")
  581. (votes . "Votes")
  582. (popularity . "Popularity")
  583. (license . "License")
  584. (description . "Description")
  585. (keywords . "Keywords")
  586. (version . "Version")
  587. (name . "Name")
  588. (id . "ID")
  589. (base-name . "Package Base")
  590. (base-id . "Package Base ID")
  591. (maintainer . "Maintainer")
  592. (installed-name . "Name")
  593. (installed-version . "Version")
  594. (installed-provides . "Provides")
  595. (installed-depends . "Depends On")
  596. (installed-conflicts . "Conflicts With")
  597. (installed-replaces . "Replaces")
  598. (architecture . "Architecture")
  599. (provides . "Provides")
  600. (depends . "Depends On")
  601. (depends-make . "Make Deps")
  602. (depends-opt . "Optional Deps")
  603. (script . "Install Script")
  604. (reason . "Install Reason")
  605. (validated . "Validated By")
  606. (required . "Required By")
  607. (optional-for . "Optional For")
  608. (conflicts . "Conflicts With")
  609. (replaces . "Replaces")
  610. (installed-size . "Size")
  611. (packager . "Packager")
  612. (build-date . "Build Date")
  613. (install-date . "Install Date")
  614. (voted . "Voted")
  615. (subscribed . "Subscribed"))
  616. "Association list of symbols and descriptions of parameters.
  617. Descriptions are used for displaying package information.
  618. Symbols are either from `aurel-aur-param-alist', from
  619. `aurel-pacman-param-alist' or are added by filter functions. See
  620. `aurel-apply-filters' for details.")
  621. (defun aurel-get-aur-param-name (param-symbol)
  622. "Return a name (string) of a parameter.
  623. PARAM-SYMBOL is a symbol from `aurel-aur-param-alist'."
  624. (cdr (assoc param-symbol aurel-aur-param-alist)))
  625. (defun aurel-get-aur-param-symbol (param-name)
  626. "Return a symbol name of a parameter.
  627. PARAM-NAME is a string from `aurel-aur-param-alist'."
  628. (car (rassoc param-name aurel-aur-param-alist)))
  629. (defun aurel-get-pacman-param-name (param-symbol)
  630. "Return a name (string) of a parameter.
  631. PARAM-SYMBOL is a symbol from `aurel-pacman-param-alist'."
  632. (cdr (assoc param-symbol aurel-pacman-param-alist)))
  633. (defun aurel-get-pacman-param-symbol (param-name)
  634. "Return a symbol name of a parameter.
  635. PARAM-NAME is a string from `aurel-pacman-param-alist'."
  636. (car (rassoc param-name aurel-pacman-param-alist)))
  637. (defun aurel-get-param-description (param-symbol)
  638. "Return a description of a parameter PARAM-SYMBOL."
  639. (let ((desc (cdr (assoc param-symbol
  640. aurel-param-description-alist))))
  641. (or desc
  642. (progn
  643. (setq desc (symbol-name param-symbol))
  644. (message "Couldn't find '%s' in aurel-param-description-alist."
  645. desc)
  646. desc))))
  647. (defun aurel-get-param-val (param info)
  648. "Return a value of a parameter PARAM from a package INFO."
  649. (cdr (assoc param info)))
  650. ;;; Filters for processing package info
  651. (defvar aurel-filter-params nil
  652. "List of parameters (symbols), that should match specified strings.
  653. Used in `aurel-filter-contains-every-string'.")
  654. (defvar aurel-filter-strings nil
  655. "List of strings, a package info should match.
  656. Used in `aurel-filter-contains-every-string'.")
  657. (defvar aurel-aur-filters
  658. '(aurel-aur-filter-intern aurel-filter-contains-every-string
  659. aurel-aur-filter-date aurel-filter-pkg-url)
  660. "List of filter functions applied to a package info got from AUR.
  661. Each filter function should accept a single argument - info alist
  662. with package parameters and should return info alist or
  663. nil (which means: ignore this package info). Functions may
  664. modify associations or add the new ones to the alist. In the
  665. latter case you might want to add descriptions of the added
  666. symbols into `aurel-param-description-alist'.
  667. `aurel-aur-filter-intern' should be the first symbol in the list as
  668. other filters use symbols for working with info parameters (see
  669. `aurel-aur-param-alist').
  670. For more information, see `aurel-receive-packages-info'.")
  671. (defvar aurel-pacman-filters
  672. '(aurel-pacman-filter-intern aurel-pacman-filter-date)
  673. "List of filter functions applied to a package info got from pacman.
  674. `aurel-pacman-filter-intern' should be the first symbol in the list as
  675. other filters use symbols for working with info parameters (see
  676. `aurel-pacman-param-alist').
  677. For more information, see `aurel-aur-filters' and
  678. `aurel-receive-packages-info'.")
  679. (defvar aurel-final-filters
  680. '()
  681. "List of filter functions applied to a package info.
  682. For more information, see `aurel-receive-packages-info'.")
  683. (defun aurel-apply-filters (info filters)
  684. "Apply functions from FILTERS list to a package INFO.
  685. INFO is alist with package parameters. It is passed as an
  686. argument to the first function from FILTERS, the returned result
  687. is passed to the second function from that list and so on.
  688. Return filtered info (result of the last filter). Return nil, if
  689. one of the FILTERS returns nil (do not call the rest filters)."
  690. (cl-loop for fun in filters
  691. do (setq info (funcall fun info))
  692. while info
  693. finally return info))
  694. (defun aurel-filter-intern (info param-fun &optional warning)
  695. "Replace names of parameters with symbols in a package INFO.
  696. INFO is alist of parameter names (strings) and values.
  697. PARAM-FUN is a function for getting parameter internal symbol by
  698. its name (string).
  699. If WARNING is non-nil, show a message if unknown parameter is found.
  700. Return modified info."
  701. (delq nil
  702. (mapcar
  703. (lambda (param)
  704. (let* ((param-name (car param))
  705. (param-symbol (funcall param-fun param-name))
  706. (param-val (cdr param)))
  707. (if param-symbol
  708. (cons param-symbol param-val)
  709. (and warning
  710. (message "Warning: unknown parameter '%s'. It will be omitted."
  711. param-name))
  712. nil)))
  713. info)))
  714. (defun aurel-aur-filter-intern (info)
  715. "Replace names of parameters with symbols in a package INFO.
  716. INFO is alist of parameter names (strings) from
  717. `aurel-aur-param-alist' and their values.
  718. Return modified info."
  719. (aurel-filter-intern info 'aurel-get-aur-param-symbol t))
  720. (defun aurel-pacman-filter-intern (info)
  721. "Replace names of parameters with symbols in a package INFO.
  722. INFO is alist of parameter names (strings) from
  723. `aurel-pacman-param-alist' and their values.
  724. Return modified info."
  725. (aurel-filter-intern info 'aurel-get-pacman-param-symbol))
  726. (defun aurel-filter-contains-every-string (info)
  727. "Check if a package INFO contains all necessary strings.
  728. Return INFO, if values of parameters from `aurel-filter-params'
  729. contain all strings from `aurel-filter-strings', otherwise return nil.
  730. Pass the check (return INFO), if `aurel-filter-strings' or
  731. `aurel-filter-params' is nil."
  732. (when (or (null aurel-filter-params)
  733. (null aurel-filter-strings)
  734. (let ((str (mapconcat (lambda (param)
  735. (aurel-get-param-val param info))
  736. aurel-filter-params
  737. "\n")))
  738. (cl-every (lambda (substr)
  739. (string-match-p (regexp-quote substr) str))
  740. aurel-filter-strings)))
  741. info))
  742. (defun aurel-filter-date (info fun &rest params)
  743. "Convert date parameters PARAMS of a package INFO to time values.
  744. INFO is alist of parameter symbols and values.
  745. FUN is a function taking parameter value as an argument and
  746. returning time value.
  747. Return modified info."
  748. (dolist (param info info)
  749. (let ((param-name (car param))
  750. (param-val (cdr param)))
  751. (when (memq param-name params)
  752. (setcdr param
  753. (funcall fun param-val))))))
  754. (defun aurel-aur-filter-date (info)
  755. "Convert date parameters PARAMS of a package INFO to time values.
  756. Converted parameters: `first-date', `last-date', `outdated'.
  757. INFO is alist of parameter symbols and values.
  758. Return modified info."
  759. (aurel-filter-date
  760. info
  761. (lambda (sec)
  762. (and sec (seconds-to-time sec)))
  763. 'first-date 'last-date 'outdated))
  764. (defun aurel-pacman-filter-date (info)
  765. "Convert date parameters PARAMS of a package INFO to time values.
  766. Converted parameters: `install-date', `build-date'.
  767. INFO is alist of parameter symbols and values.
  768. Return modified info."
  769. (aurel-filter-date info 'date-to-time 'install-date 'build-date))
  770. (defun aurel-filter-pkg-url (info)
  771. "Update `pkg-url' parameter in a package INFO.
  772. INFO is alist of parameter symbols and values.
  773. Return modified info."
  774. (let ((param (assoc 'pkg-url info)))
  775. (setcdr param (url-expand-file-name (cdr param) aurel-aur-base-url)))
  776. info)
  777. ;;; Searching/showing packages
  778. (defun aurel-receive-packages-info (url)
  779. "Return information about the packages from URL.
  780. Information is received with `aurel-get-aur-packages-info', then
  781. it is passed through `aurel-aur-filters' with
  782. `aurel-apply-filters'. If `aurel-installed-packages-check' is
  783. non-nil, additional information about installed packages is
  784. received with `aurel-get-installed-packages-info' and is passed
  785. through `aurel-installed-filters'. Finally packages info is passed
  786. through `aurel-final-filters'.
  787. Returning value has a form of `aurel-list'."
  788. ;; To speed-up the process, pacman should be called once with the
  789. ;; names of found packages (instead of calling it for each name). So
  790. ;; we need to know the names at first, that's why we don't use a
  791. ;; single filters variable: at first we filter info received from AUR,
  792. ;; then we add information about installed packages from pacman and
  793. ;; finally filter the whole info.
  794. (let (aur-info-list aur-info-alist
  795. pac-info-list pac-info-alist
  796. info-list)
  797. ;; Receive and process information from AUR server
  798. (setq aur-info-list (aurel-get-aur-packages-info url)
  799. aur-info-alist (aurel-get-filtered-alist
  800. aur-info-list aurel-aur-filters 'name))
  801. ;; Receive and process information from pacman
  802. (when aurel-installed-packages-check
  803. (setq pac-info-list (apply 'aurel-get-installed-packages-info
  804. (mapcar #'car aur-info-alist))
  805. pac-info-alist (aurel-get-filtered-alist
  806. pac-info-list
  807. aurel-pacman-filters
  808. 'installed-name)))
  809. ;; Join info and do final processing
  810. (setq info-list
  811. (mapcar (lambda (aur-info-assoc)
  812. (let* ((name (car aur-info-assoc))
  813. (pac-info-assoc (assoc name pac-info-alist)))
  814. (append (cdr aur-info-assoc)
  815. (cdr pac-info-assoc))))
  816. aur-info-alist))
  817. (aurel-get-filtered-alist info-list aurel-final-filters 'id)))
  818. (defun aurel-get-filtered-alist (info-list filters param)
  819. "Return alist with filtered packages info.
  820. INFO-LIST is a list of packages info. Each info is passed through
  821. FILTERS with `aurel-apply-filters'.
  822. Each association of a returned value has a form:
  823. (PARAM-VAL . INFO)
  824. PARAM-VAL is a value of a parameter PARAM.
  825. INFO is a filtered package info."
  826. (delq nil ; ignore filtered (empty) info
  827. (mapcar (lambda (info)
  828. (let ((info (aurel-apply-filters info filters)))
  829. (and info
  830. (cons (aurel-get-param-val param info) info))))
  831. info-list)))
  832. (defun aurel-get-packages-by-name (&rest names)
  833. "Return packages by package NAMES (list of strings).
  834. Returning value has a form of `aurel-list'."
  835. (aurel-receive-packages-info
  836. (apply #'aurel-get-package-info-url names)))
  837. (defun aurel-get-packages-by-string (&rest strings)
  838. "Return packages matching STRINGS.
  839. Returning value has a form of `aurel-list'."
  840. ;; A hack for searching by multiple strings: the actual server search
  841. ;; is done by the biggest string and the rest strings are searched in
  842. ;; the results returned by the server
  843. (let* ((str-list
  844. ;; sort to search by the biggest (first) string
  845. (sort strings
  846. (lambda (a b)
  847. (> (length a) (length b)))))
  848. (aurel-filter-params '(name description))
  849. (aurel-filter-strings (cdr str-list)))
  850. (aurel-receive-packages-info
  851. (aurel-get-package-search-url (car str-list)))))
  852. (defun aurel-get-packages-by-name-string (string)
  853. "Return packages with name containing STRING.
  854. Returning value has a form of `aurel-list'."
  855. (aurel-receive-packages-info
  856. (aurel-get-package-name-search-url string)))
  857. (defun aurel-get-packages-by-maintainer (name)
  858. "Return packages by maintainer NAME.
  859. Returning value has a form of `aurel-list'."
  860. (aurel-receive-packages-info
  861. (aurel-get-maintainer-search-url name)))
  862. (defvar aurel-search-type-alist
  863. '((name . aurel-get-packages-by-name)
  864. (string . aurel-get-packages-by-string)
  865. (name-string . aurel-get-packages-by-name-string)
  866. (maintainer . aurel-get-packages-by-maintainer))
  867. "Alist of available search types and search functions.")
  868. (defun aurel-search-packages (type &rest vals)
  869. "Search for AUR packages and return results.
  870. TYPE is a type of search - symbol from `aurel-search-type-alist'.
  871. It defines a search function which is called with VALS as
  872. arguments.
  873. Returning value has a form of `aurel-list'."
  874. (let ((fun (cdr (assoc type aurel-search-type-alist))))
  875. (or fun
  876. (error "Wrong search type '%s'" type))
  877. (apply fun vals)))
  878. (defun aurel-search-show-packages
  879. (search-type search-vals &optional buffer history)
  880. "Search for packages and show results in BUFFER.
  881. See `aurel-search-packages' for the meaning of SEARCH-TYPE and
  882. SEARCH-VALS.
  883. See `aurel-show-packages' for the meaning of BUFFER and HISTORY."
  884. (aurel-show-packages
  885. (apply 'aurel-search-packages search-type search-vals)
  886. buffer history search-type search-vals))
  887. (defun aurel-show-packages
  888. (packages &optional buffer history search-type search-vals)
  889. "Show PACKAGES in BUFFER.
  890. PACKAGES should have a form of `aurel-list'.
  891. If BUFFER is a buffer object, use it; if BUFFER is nil, use a
  892. default buffer; otherwise, use a unique buffer.
  893. If HISTORY is nil, do not save current item in history; if it is
  894. `add', add item to history; if `replace', replace current item.
  895. History item is a proper call of `aurel-show-packages' itself.
  896. If SEARCH-TYPE and SEARCH-VALS are non-nils, they are used for
  897. setting reverting action. See `aurel-set-revert-action' for
  898. details."
  899. (let ((count (length packages)))
  900. (when (> count 0)
  901. (if (and (= count 1)
  902. (or (eq search-type 'name)
  903. (null aurel-list-single-package)))
  904. (let ((info (cdar packages)))
  905. ;; Add (maybe) AUR user info if the buffer is reverted or a
  906. ;; new info is shown; if we are moving by a history
  907. ;; (`history' is nil), do not add it.
  908. (and history
  909. aurel-aur-user-package-info-check
  910. (aurel-add-aur-user-package-info info))
  911. (aurel-info-show info
  912. (if (bufferp buffer)
  913. buffer
  914. (aurel-info-get-buffer-name buffer))))
  915. (aurel-list-show packages
  916. (if (bufferp buffer)
  917. buffer
  918. (aurel-list-get-buffer-name buffer))))
  919. (when (and search-type search-vals)
  920. (when history
  921. (aurel-history-add
  922. (list (lambda (packages type vals)
  923. (aurel-show-packages
  924. packages (current-buffer) nil type vals))
  925. packages search-type search-vals)
  926. (eq history 'replace)))
  927. (aurel-set-revert-action search-type search-vals)))
  928. (aurel-found-message packages search-type search-vals)))
  929. (defvar aurel-found-messages
  930. '((name (0 "The package \"%s\" not found." "Packages not found.")
  931. (1 "The package \"%s\"."))
  932. (string (0 "No packages matching %s.")
  933. (1 "A single package matching %s.")
  934. (many "%d packages matching %s."))
  935. (maintainer (0 "No packages by maintainer %s.")
  936. (1 "A single package by maintainer %s.")
  937. (many "%d packages by maintainer %s.")))
  938. "Alist used by `aurel-found-message'.")
  939. (defun aurel-found-message (packages search-type search-vals)
  940. "Display a proper message about found PACKAGES.
  941. SEARCH-TYPE and SEARCH-VALS are arguments for
  942. `aurel-search-packages', by which the PACKAGES were found."
  943. (let* ((count (length packages))
  944. (found-key (if (> count 1) 'many count))
  945. (type-alist (cdr (assoc search-type aurel-found-messages)))
  946. (found-list (cdr (assoc found-key type-alist)))
  947. (msg (if (or (= 1 (length search-vals))
  948. (null (cdr found-list)))
  949. (car found-list)
  950. (cadr found-list)))
  951. (args (delq nil
  952. (list
  953. (and (eq found-key 'many) count)
  954. (cond
  955. ((eq search-type 'string)
  956. (mapconcat (lambda (str) (concat "\"" str "\""))
  957. search-vals " "))
  958. ((and (= count 1) (eq search-type 'name))
  959. (aurel-get-param-val 'name (cdar packages)))
  960. (t (car search-vals)))))))
  961. (and msg (apply 'message msg args))))
  962. ;;; History
  963. (defvar-local aurel-history-stack-item nil
  964. "Current item of the history.
  965. A list of the form (FUNCTION [ARGS ...]).
  966. The item is used by calling (apply FUNCTION ARGS).")
  967. (put 'aurel-history-stack-item 'permanent-local t)
  968. (defvar-local aurel-history-back-stack nil
  969. "Stack (list) of visited items.
  970. Each element of the list has a form of `aurel-history-stack-item'.")
  971. (put 'aurel-history-back-stack 'permanent-local t)
  972. (defvar-local aurel-history-forward-stack nil
  973. "Stack (list) of items visited with `aurel-history-back'.
  974. Each element of the list has a form of `aurel-history-stack-item'.")
  975. (put 'aurel-history-forward-stack 'permanent-local t)
  976. (defvar aurel-history-size 0
  977. "Maximum number of items saved in history.
  978. If 0, the history is disabled.")
  979. (defun aurel-history-add (item &optional replace)
  980. "Add ITEM to history.
  981. If REPLACE is non-nil, replace the current item instead of adding."
  982. (if replace
  983. (setq aurel-history-stack-item item)
  984. (and aurel-history-stack-item
  985. (push aurel-history-stack-item aurel-history-back-stack))
  986. (setq aurel-history-forward-stack nil
  987. aurel-history-stack-item item)
  988. (when (>= (length aurel-history-back-stack)
  989. aurel-history-size)
  990. (setq aurel-history-back-stack
  991. (cl-loop for elt in aurel-history-back-stack
  992. for i from 1 to aurel-history-size
  993. collect elt)))))
  994. (defun aurel-history-goto (item)
  995. "Go to the ITEM of history.
  996. ITEM should have the form of `aurel-history-stack-item'."
  997. (or (listp item)
  998. (error "Wrong value of history element"))
  999. (setq aurel-history-stack-item item)
  1000. (apply (car item) (cdr item)))
  1001. (defun aurel-history-back ()
  1002. "Go back to the previous element of history in the current buffer."
  1003. (interactive)
  1004. (or aurel-history-back-stack
  1005. (user-error "No previous element in history"))
  1006. (push aurel-history-stack-item aurel-history-forward-stack)
  1007. (aurel-history-goto (pop aurel-history-back-stack)))
  1008. (defun aurel-history-forward ()
  1009. "Go forward to the next element of history in the current buffer."
  1010. (interactive)
  1011. (or aurel-history-forward-stack
  1012. (user-error "No next element in history"))
  1013. (push aurel-history-stack-item aurel-history-back-stack)
  1014. (aurel-history-goto (pop aurel-history-forward-stack)))
  1015. ;;; Reverting buffers
  1016. (defcustom aurel-revert-no-confirm nil
  1017. "If non-nil, do not ask to confirm for reverting aurel buffer."
  1018. :type 'boolean
  1019. :group 'aurel)
  1020. (defvar aurel-revert-action nil
  1021. "Action for refreshing information in the current aurel buffer.
  1022. A list of the form (FUNCTION [ARGS ...]).
  1023. The action is performed by calling (apply FUNCTION ARGS).")
  1024. (defun aurel-revert-buffer (_ignore-auto noconfirm)
  1025. "Refresh information in the current aurel buffer.
  1026. The function is suitable for `revert-buffer-function'.
  1027. See `revert-buffer' for the meaning of and NOCONFIRM."
  1028. (when (or aurel-revert-no-confirm
  1029. noconfirm
  1030. (y-or-n-p "Refresh current information? "))
  1031. (apply (car aurel-revert-action)
  1032. (cdr aurel-revert-action))))
  1033. (defun aurel-set-revert-action (search-type search-vals)
  1034. "Set `aurel-revert-action' to a proper value.
  1035. SEARCH-TYPE and SEARCH-VALS are arguments for
  1036. `aurel-search-show-packages' by which refreshing information is
  1037. performed."
  1038. (setq aurel-revert-action
  1039. (list (lambda (type vals)
  1040. (aurel-search-show-packages
  1041. type vals (current-buffer) 'replace))
  1042. search-type search-vals)))
  1043. ;;; Downloading
  1044. (defcustom aurel-download-directory temporary-file-directory
  1045. "Default directory for downloading AUR packages."
  1046. :type 'directory
  1047. :group 'aurel)
  1048. (defcustom aurel-directory-prompt "Download to: "
  1049. "Default directory prompt for downloading AUR packages."
  1050. :type 'string
  1051. :group 'aurel)
  1052. (defvar aurel-download-functions
  1053. '(aurel-download aurel-download-unpack aurel-download-unpack-dired
  1054. aurel-download-unpack-pkgbuild aurel-download-unpack-eshell)
  1055. "List of available download functions.")
  1056. (defun aurel-download-get-defcustom-type ()
  1057. "Return `defcustom' type for selecting a download function."
  1058. `(radio ,@(mapcar (lambda (fun) (list 'function-item fun))
  1059. aurel-download-functions)
  1060. (function :tag "Other function")))
  1061. (defun aurel-download (url dir)
  1062. "Download AUR package from URL to a directory DIR.
  1063. Return a path to the downloaded file."
  1064. ;; Is there a simpler way to download a file?
  1065. (let ((file-name-handler-alist
  1066. (cons (cons url-handler-regexp 'url-file-handler)
  1067. file-name-handler-alist)))
  1068. (with-temp-buffer
  1069. (insert-file-contents-literally url)
  1070. (let ((file (expand-file-name (url-file-nondirectory url) dir)))
  1071. (write-file file)
  1072. file))))
  1073. ;; Code for working with `tar-mode' came from `package-untar-buffer'
  1074. ;; Avoid compilation warnings about tar functions and variables
  1075. (defvar tar-parse-info)
  1076. (defvar tar-data-buffer)
  1077. (declare-function tar-untar-buffer "tar-mode" ())
  1078. (declare-function tar-header-name "tar-mode" (tar-header) t)
  1079. (declare-function tar-header-link-type "tar-mode" (tar-header) t)
  1080. (defun aurel-tar-subdir (tar-info)
  1081. "Return directory name where files from TAR-INFO will be extracted."
  1082. (let* ((first-header (car tar-info))
  1083. (first-header-type (tar-header-link-type first-header)))
  1084. (cl-case first-header-type
  1085. (55 ; pax_global_header
  1086. ;; There are other special headers (see `tar--check-descriptor', for
  1087. ;; example). Should they also be ignored?
  1088. (aurel-tar-subdir (cdr tar-info)))
  1089. (5 ; directory
  1090. (let* ((dir-name (tar-header-name first-header))
  1091. (dir-re (regexp-quote dir-name)))
  1092. (dolist (tar-data (cdr tar-info))
  1093. (or (string-match dir-re (tar-header-name tar-data))
  1094. (error (concat "Not all files are going to be extracted"
  1095. " into directory '%s'")
  1096. dir-name)))
  1097. dir-name))
  1098. (t
  1099. (error "The first entry '%s' in tar file is not a directory"
  1100. (tar-header-name first-header))))))
  1101. (defun aurel-download-unpack (url dir)
  1102. "Download AUR package from URL and unpack it into a directory DIR.
  1103. Use `tar-untar-buffer' from Tar mode. All files should be placed
  1104. in one directory; otherwise, signal an error.
  1105. Return a path to the unpacked directory."
  1106. (let ((file-name-handler-alist
  1107. (cons (cons url-handler-regexp 'url-file-handler)
  1108. file-name-handler-alist)))
  1109. (with-temp-buffer
  1110. (insert-file-contents url)
  1111. (setq default-directory dir)
  1112. (let ((file (expand-file-name (url-file-nondirectory url) dir)))
  1113. (write-file file))
  1114. (tar-mode)
  1115. (let ((tar-dir (aurel-tar-subdir tar-parse-info)))
  1116. (tar-untar-buffer)
  1117. (expand-file-name tar-dir dir)))))
  1118. (defun aurel-download-unpack-dired (url dir)
  1119. "Download and unpack AUR package, and open the unpacked directory.
  1120. For the meaning of URL and DIR, see `aurel-download-unpack'."
  1121. (dired (aurel-download-unpack url dir)))
  1122. (defun aurel-download-unpack-pkgbuild (url dir)
  1123. "Download and unpack AUR package, and open PKGBUILD file.
  1124. For the meaning of URL and DIR, see `aurel-download-unpack'."
  1125. (let* ((pkg-dir (aurel-download-unpack url dir))
  1126. (file (expand-file-name "PKGBUILD" pkg-dir)))
  1127. (if (file-exists-p file)
  1128. (find-file file)
  1129. (error "File '%s' doesn't exist" file))))
  1130. ;; Avoid compilation warning about `eshell/cd'
  1131. (declare-function eshell/cd "em-dirs" (&rest args))
  1132. (defun aurel-download-unpack-eshell (url dir)
  1133. "Download and unpack AUR package, switch to eshell.
  1134. For the meaning of URL and DIR, see `aurel-download-unpack'."
  1135. (let ((pkg-dir (aurel-download-unpack url dir)))
  1136. (eshell)
  1137. (eshell/cd pkg-dir)))
  1138. ;;; Defining URL
  1139. (defun aurel-get-fields-string (args)
  1140. "Return string of names and values from ARGS alist.
  1141. Each association of ARGS has a form: (NAME . VALUE).
  1142. If NAME and VALUE are not strings, they are converted to strings
  1143. with `prin1-to-string'.
  1144. Returning string has a form: \"NAME=VALUE&...\"."
  1145. (cl-flet ((hexify (arg)
  1146. (url-hexify-string
  1147. (if (stringp arg) arg (prin1-to-string arg)))))
  1148. (mapconcat (lambda (arg)
  1149. (concat (car arg)
  1150. "="
  1151. (hexify (cdr arg))))
  1152. args
  1153. "&")))
  1154. (defun aurel-get-rpc-url (type args)
  1155. "Return URL for getting info about AUR packages.
  1156. TYPE is the name of an allowed method.
  1157. ARGS should have a form taken by `aurel-get-fields-string'."
  1158. (url-expand-file-name
  1159. (concat "rpc/?"
  1160. (aurel-get-fields-string
  1161. (append `(("v" . "5") ; v5 of the RPC API.
  1162. ("type" . ,type))
  1163. args)))
  1164. aurel-aur-base-url))
  1165. (defun aurel-get-package-info-url (&rest names)
  1166. "Return URL for getting info about packages with NAMES."
  1167. (let ((args (mapcar (lambda (name)
  1168. (cons "arg[]" name))
  1169. names)))
  1170. (aurel-get-rpc-url "info" args)))
  1171. (defun aurel-get-package-search-url (str &optional field)
  1172. "Return URL for searching a package by string STR.
  1173. FIELD is a field (string) for searching. May be: 'name',
  1174. 'name-desc' (default) or 'maintainer'."
  1175. (or field (setq field "name-desc"))
  1176. (aurel-get-rpc-url
  1177. "search"
  1178. `(("by" . ,field)
  1179. ("arg" . ,str))))
  1180. (defun aurel-get-package-name-search-url (str)
  1181. "Return URL for searching a package name by string STR."
  1182. (aurel-get-package-search-url str "name"))
  1183. (defun aurel-get-maintainer-search-url (str)
  1184. "Return URL for searching a maintainer by string STR."
  1185. (aurel-get-package-search-url str "maintainer"))
  1186. (defun aurel-get-maintainer-account-url (maintainer)
  1187. "Return URL for MAINTAINER's AUR account."
  1188. (url-expand-file-name (concat "account/" maintainer)
  1189. aurel-aur-base-url))
  1190. (defun aurel-get-aur-package-url (package)
  1191. "Return AUR URL of a PACKAGE."
  1192. (url-expand-file-name (concat "packages/" package)
  1193. aurel-aur-base-url))
  1194. (defun aurel-get-package-base-url (package-base)
  1195. "Return AUR URL of a PACKAGE-BASE."
  1196. (url-expand-file-name (concat "pkgbase/" package-base)
  1197. aurel-aur-base-url))
  1198. (defun aurel-get-package-action-url (package-base action)
  1199. "Return URL for the PACKAGE-BASE ACTION."
  1200. (concat (aurel-get-package-base-url package-base)
  1201. "/" action))
  1202. ;;; UI
  1203. (defvar aurel-package-info-history nil
  1204. "A history list for `aurel-package-info'.")
  1205. (defvar aurel-package-search-history nil
  1206. "A history list for `aurel-package-search'.")
  1207. (defvar aurel-maintainer-search-history nil
  1208. "A history list for `aurel-maintainer-search'.")
  1209. ;;;###autoload
  1210. (defun aurel-package-info (name &optional arg)
  1211. "Display information about AUR package with NAME.
  1212. The buffer for showing results is defined by `aurel-info-buffer-name'.
  1213. With prefix (if ARG is non-nil), show results in a new info buffer."
  1214. (interactive
  1215. (list (read-string "Name: "
  1216. nil 'aurel-package-info-history)
  1217. current-prefix-arg))
  1218. (aurel-search-show-packages 'name (list name) arg 'add))
  1219. ;;;###autoload
  1220. (defun aurel-package-search (string &optional arg)
  1221. "Search for AUR packages matching STRING.
  1222. STRING can be a string of multiple words separated by spaces. To
  1223. search for a string containing spaces, quote it with double
  1224. quotes. For example, the following search is allowed:
  1225. \"python library\" plot
  1226. The buffer for showing results is defined by
  1227. `aurel-list-buffer-name'. With prefix (if ARG is non-nil), show
  1228. results in a new buffer."
  1229. (interactive
  1230. (list (read-string "Search by name/description: "
  1231. nil 'aurel-package-search-history)
  1232. current-prefix-arg))
  1233. (aurel-search-show-packages
  1234. 'string (split-string-and-unquote string) arg 'add))
  1235. ;;;###autoload
  1236. (defun aurel-package-search-by-name (string &optional arg)
  1237. "Search for AUR packages with name containing STRING.
  1238. The buffer for showing results is defined by
  1239. `aurel-list-buffer-name'. With prefix (if ARG is non-nil), show
  1240. results in a new buffer."
  1241. (interactive
  1242. (list (read-string "Search by name: "
  1243. nil 'aurel-package-search-history)
  1244. current-prefix-arg))
  1245. (aurel-search-show-packages
  1246. 'name-string (list string) arg 'add))
  1247. ;;;###autoload
  1248. (defun aurel-maintainer-search (name &optional arg)
  1249. "Search for AUR packages by maintainer NAME.
  1250. The buffer for showing results is defined by `aurel-list-buffer-name'.
  1251. With prefix (if ARG is non-nil), show results in a new buffer."
  1252. (interactive
  1253. (list (read-string "Search by maintainer: "
  1254. nil 'aurel-maintainer-search-history)
  1255. current-prefix-arg))
  1256. (aurel-search-show-packages
  1257. 'maintainer (list name) arg 'add))
  1258. ;;;###autoload
  1259. (defun aurel-installed-packages (&optional arg)
  1260. "Display information about AUR packages installed in the system.
  1261. The buffer for showing results is defined by `aurel-list-buffer-name'.
  1262. With prefix (if ARG is non-nil), show results in a new buffer."
  1263. (interactive "P")
  1264. (aurel-search-show-packages
  1265. 'name (aurel-get-foreign-packages) arg 'add))
  1266. ;;; Package list
  1267. (defgroup aurel-list nil
  1268. "Buffer with a list of AUR packages."
  1269. :group 'aurel)
  1270. (defface aurel-list-marked
  1271. '((t :inherit dired-marked))
  1272. "Face used for the marked packages."
  1273. :group 'aurel-list)
  1274. (defcustom aurel-list-buffer-name "*AUR Package List*"
  1275. "Default name of the buffer with a list of AUR packages."
  1276. :type 'string
  1277. :group 'aurel-list)
  1278. (defcustom aurel-list-mode-name "AURel-List"
  1279. "Default name of `aurel-list-mode', displayed in the mode line."
  1280. :type 'string
  1281. :group 'aurel-list)
  1282. (defcustom aurel-list-download-function 'aurel-download-unpack
  1283. "Function used for downloading a single AUR package from list buffer.
  1284. It should accept 2 arguments: URL of a downloading file and a
  1285. destination directory."
  1286. :type (aurel-download-get-defcustom-type)
  1287. :group 'aurel-list)
  1288. (defcustom aurel-list-multi-download-function 'aurel-download-unpack
  1289. "Function used for downloading multiple AUR packages from list buffer.
  1290. It should accept 2 arguments: URL of a downloading file and a
  1291. destination directory."
  1292. :type (aurel-download-get-defcustom-type)
  1293. :group 'aurel-list)
  1294. (defcustom aurel-list-multi-download-no-confirm nil
  1295. "If non-nil, do not ask to confirm if multiple packages are downloaded."
  1296. :type 'boolean
  1297. :group 'aurel-list)
  1298. (defcustom aurel-list-history-size 10
  1299. "Maximum number of items saved in history of package list buffer.
  1300. If 0, the history is disabled."
  1301. :type 'integer
  1302. :group 'aurel-list)
  1303. (defvar aurel-list-column-name-alist
  1304. '((installed-version . "Installed"))
  1305. "Alist of parameter names used as titles for columns.
  1306. Each association is a cons of parameter symbol and column name.
  1307. If no parameter is not found in this alist, the value from
  1308. `aurel-param-description-alist' is used for a column name.")
  1309. (defvar aurel-list-column-value-alist
  1310. '((name . aurel-list-get-name)
  1311. (maintainer . aurel-list-get-maintainer)
  1312. (popularity . aurel-list-get-popularity)
  1313. (installed-version . aurel-list-get-installed-version))
  1314. "Alist for parameter values inserted in columns.
  1315. Each association is a cons of parameter symbol from
  1316. `aurel-param-description-alist' and a function returning a value
  1317. that will be inserted. The function should take a package info
  1318. of the form of `aurel-info' as an argument.")
  1319. (defvar aurel-list nil
  1320. "Alist with packages info.
  1321. Car of each assoc is a package ID (number).
  1322. Cdr - is alist of package info of the form of `aurel-info'.")
  1323. (defvar aurel-list-filters nil
  1324. "List of filter functions applied to a package info.
  1325. Each filter function should accept a single argument - info alist
  1326. with package parameters and should return info alist or
  1327. nil (which means: do not display this package). These filters
  1328. are applied before displaying the list of packages.")
  1329. (defvar aurel-list-available-filters
  1330. '(aurel-list-filter-maintained aurel-list-filter-unmaintained
  1331. aurel-list-filter-outdated aurel-list-filter-not-outdated
  1332. aurel-list-filter-match-regexp aurel-list-filter-not-match-regexp
  1333. aurel-list-filter-different-versions aurel-list-filter-same-versions)
  1334. "List of commands that can be called for filtering a package list.
  1335. Used by `aurel-list-enable-filter'.
  1336. Each function should make a proper filter function and should
  1337. take one argument and pass those to `aurel-list-apply-filter'.")
  1338. (defvar aurel-list-marks nil
  1339. "Alist of current marks.
  1340. Each association is a cons cell of a package ID and overlay used
  1341. to highlight a line with this package.")
  1342. (defvar aurel-list-votes-column nil
  1343. "The number of column with votes in the current tabulated-list.")
  1344. (defvar aurel-list-column-format
  1345. '((name 20 t)
  1346. (version 12 nil)
  1347. (installed-version 12 t)
  1348. (maintainer 13 t)
  1349. ;; We cannot use simple sort for votes as they will be sorted as
  1350. ;; strings, e.g.: (1, 13, 2, 200, 3) instead of (1, 2, 3, 13, 200).
  1351. ;; So we use a special function to compare votes as numbers.
  1352. (votes 8 aurel-list-sort-by-votes)
  1353. (popularity 12 t)
  1354. (description 30 nil))
  1355. "List specifying columns used in the buffer with a list of packages.
  1356. Each element of the list should have the form (NAME WIDTH SORT . PROPS).
  1357. NAME is a parameter symbol from `aurel-param-description-alist'.
  1358. For the meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
  1359. (defvar aurel-list-filter-map
  1360. (let ((map (make-sparse-keymap)))
  1361. (define-key map (kbd "f") 'aurel-list-enable-filter)
  1362. (define-key map (kbd "d") 'aurel-list-disable-filters)
  1363. (define-key map (kbd "v") 'aurel-list-filter-same-versions)
  1364. (define-key map (kbd "V") 'aurel-list-filter-different-versions)
  1365. (define-key map (kbd "m") 'aurel-list-filter-unmaintained)
  1366. (define-key map (kbd "M") 'aurel-list-filter-maintained)
  1367. (define-key map (kbd "o") 'aurel-list-filter-outdated)
  1368. (define-key map (kbd "O") 'aurel-list-filter-not-outdated)
  1369. (define-key map (kbd "r") 'aurel-list-filter-not-match-regexp)
  1370. (define-key map (kbd "R") 'aurel-list-filter-match-regexp)
  1371. map)
  1372. "Keymap with filter commands for `aurel-list-mode'.")
  1373. (fset 'aurel-list-filter-map aurel-list-filter-map)
  1374. (defvar aurel-list-mode-map
  1375. (let ((map (make-sparse-keymap)))
  1376. (set-keymap-parent map tabulated-list-mode-map)
  1377. (define-key map (kbd "RET") 'aurel-list-describe-package)
  1378. (define-key map (kbd "d") 'aurel-list-download-package)
  1379. (define-key map (kbd "l") 'aurel-history-back)
  1380. (define-key map (kbd "r") 'aurel-history-forward)
  1381. (define-key map (kbd "m") 'aurel-list-mark)
  1382. (define-key map (kbd "u") 'aurel-list-unmark)
  1383. (define-key map (kbd "M") 'aurel-list-mark-all)
  1384. (define-key map (kbd "U") 'aurel-list-unmark-all)
  1385. (define-key map (kbd "DEL") 'aurel-list-unmark-backward)
  1386. (define-key map (kbd "s") 'aurel-list-sort)
  1387. (define-key map (kbd "S") 'aurel-list-sort)
  1388. (define-key map (kbd "f") 'aurel-list-filter-map)
  1389. (define-key map (kbd "g") 'revert-buffer)
  1390. map)
  1391. "Keymap for `aurel-list-mode'.")
  1392. (defun aurel-list-sort-by-votes (a b)
  1393. "Compare tabulated entries A and B by the number of votes.
  1394. It is a sort predicate for `tabulated-list-format'.
  1395. Return non-nil, if A has more votes than B."
  1396. (cl-flet ((votes (entry)
  1397. (string-to-number (aref (cadr entry)
  1398. aurel-list-votes-column))))
  1399. (> (votes a) (votes b))))
  1400. (defun aurel-list-get-buffer-name (&optional unique)
  1401. "Return a name of a list buffer.
  1402. If UNIQUE is non-nil, make the name unique."
  1403. (if unique
  1404. (generate-new-buffer aurel-list-buffer-name)
  1405. aurel-list-buffer-name))
  1406. (define-derived-mode aurel-list-mode
  1407. tabulated-list-mode aurel-list-mode-name
  1408. "Major mode for browsing AUR packages.
  1409. \\{aurel-list-mode-map}"
  1410. (make-local-variable 'aurel-list)
  1411. (make-local-variable 'aurel-list-filters)
  1412. (make-local-variable 'aurel-list-marks)
  1413. (make-local-variable 'aurel-revert-action)
  1414. (setq-local revert-buffer-function 'aurel-revert-buffer)
  1415. (setq-local aurel-history-size aurel-list-history-size)
  1416. (setq-local aurel-list-votes-column
  1417. (cl-loop
  1418. for col-spec in aurel-list-column-format
  1419. for i from 0
  1420. until (eq (car col-spec) 'votes)
  1421. finally return i))
  1422. (setq default-directory aurel-download-directory)
  1423. (setq tabulated-list-format
  1424. (apply #'vector
  1425. (mapcar
  1426. (lambda (col-spec)
  1427. (let ((name (car col-spec)))
  1428. (cons (or (cdr (assoc name aurel-list-column-name-alist))
  1429. (aurel-get-param-description name))
  1430. (cdr col-spec))))
  1431. aurel-list-column-format)))
  1432. (setq tabulated-list-sort-key
  1433. (list (aurel-get-param-description 'name)))
  1434. (tabulated-list-init-header))
  1435. (defun aurel-list-show (list &optional buffer)
  1436. "Display a LIST of packages in BUFFER.
  1437. LIST should have the form of `aurel-list'.
  1438. If BUFFER is nil, use (create if needed) buffer with the name
  1439. `aurel-list-buffer-name'."
  1440. (let ((buf (get-buffer-create
  1441. (or buffer aurel-list-buffer-name))))
  1442. (with-current-buffer buf
  1443. (aurel-list-show-in-current-buffer list))
  1444. (pop-to-buffer-same-window buf)))
  1445. (defun aurel-list-show-in-current-buffer (list)
  1446. "Display a LIST of packages in current buffer.
  1447. LIST should have the form of `aurel-list'."
  1448. (let ((inhibit-read-only t))
  1449. (erase-buffer))
  1450. (aurel-list-mode)
  1451. (setq aurel-list list)
  1452. (aurel-list-print))
  1453. (defun aurel-list-print (&optional list)
  1454. "Filter and print package LIST into the current tabulated-list buffer.
  1455. If LIST is nil, use `aurel-list'."
  1456. ;; TODO restore marks for the packages that survive filtering
  1457. (aurel-list-unmark-all)
  1458. (setq tabulated-list-entries
  1459. (aurel-list-get-entries
  1460. (aurel-list-apply-filters (or list aurel-list))))
  1461. (tabulated-list-print))
  1462. (defun aurel-list-get-entries (list)
  1463. "Return list of values suitable for `tabulated-list-entries'.
  1464. Values are taken from LIST which should have the form of
  1465. `aurel-list'.
  1466. Use parameters from `aurel-list-column-format'."
  1467. (mapcar
  1468. (lambda (pkg)
  1469. (let ((id (car pkg))
  1470. (info (cdr pkg)))
  1471. (list id
  1472. (apply #'vector
  1473. (mapcar
  1474. (lambda (col-spec)
  1475. (let* ((param (car col-spec))
  1476. (fun (cdr (assq param
  1477. aurel-list-column-value-alist))))
  1478. (if fun
  1479. (funcall fun info)
  1480. (aurel-get-string
  1481. (aurel-get-param-val param info)))))
  1482. aurel-list-column-format)))))
  1483. list))
  1484. (defun aurel-list-get-name (info)
  1485. "Return name of the package from a package INFO.
  1486. Colorize the name with `aurel-info-outdated' if the package is
  1487. out of date."
  1488. (aurel-get-string
  1489. (aurel-get-param-val 'name info)
  1490. (when (aurel-get-param-val 'outdated info)
  1491. 'aurel-info-outdated)))
  1492. (defun aurel-list-get-maintainer (info)
  1493. "Return maintainer name from a package INFO."
  1494. (or (aurel-get-param-val 'maintainer info)
  1495. aurel-empty-string))
  1496. (defun aurel-list-get-popularity (info)
  1497. "Return popularity from a package INFO."
  1498. ;; Display popularity in a decimal-point notation to avoid things like
  1499. ;; "9.6e-05".
  1500. (format "%10.4f" (aurel-get-param-val 'popularity info)))
  1501. (defun aurel-list-get-installed-version (info)
  1502. "Return installed version from a package INFO."
  1503. (or (aurel-get-param-val 'installed-version info)
  1504. aurel-empty-string))
  1505. (defun aurel-list-get-current-id ()
  1506. "Return ID of the current package."
  1507. (or (tabulated-list-get-id)
  1508. (user-error "No package here")))
  1509. (defun aurel-list-get-package-info (&optional id)
  1510. "Return info for a package with ID or for the current package."
  1511. (or id
  1512. (setq id (aurel-list-get-current-id)))
  1513. (or (cdr (assoc id aurel-list))
  1514. (error "No package with ID %s in aurel-list" id)))
  1515. (defun aurel-list-describe-package (&optional arg)
  1516. "Describe the current package.
  1517. With prefix (if ARG is non-nil), show results in a new info buffer."
  1518. (interactive "P")
  1519. (let* ((id (aurel-list-get-current-id))
  1520. (info (aurel-list-get-package-info id))
  1521. (name (aurel-get-param-val 'name info)))
  1522. ;; A list of packages is received using 'search' type. However, in
  1523. ;; AUR RPC API, 'info' type returns several additional parameters
  1524. ;; ("Depends", "Replaces", ...) comparing to 'search' type. So
  1525. ;; using just `aurel-show-packages' is not enough, and re-receiving
  1526. ;; a package info (using 'info' type this time) is needed.
  1527. (aurel-search-show-packages 'name (list name) arg 'add)))
  1528. (defun aurel-list-download-package ()
  1529. "Download marked packages or the current package if nothing is marked.
  1530. With prefix, prompt for a directory with `aurel-directory-prompt'
  1531. to save the package; without prefix, save to
  1532. `aurel-download-directory' without prompting.
  1533. Use `aurel-list-download-function' if a single package is
  1534. downloaded or `aurel-list-multi-download-function' otherwise."
  1535. (interactive)
  1536. (or (derived-mode-p 'aurel-list-mode)
  1537. (user-error "Current buffer is not in aurel-list-mode"))
  1538. (let ((dir (if current-prefix-arg
  1539. (read-directory-name aurel-directory-prompt
  1540. aurel-download-directory)
  1541. aurel-download-directory))
  1542. (count (length aurel-list-marks))
  1543. (ids (mapcar #'car aurel-list-marks)))
  1544. (if (> count 1)
  1545. (when (or aurel-list-multi-download-no-confirm
  1546. (y-or-n-p (format "Download %d marked packages? "
  1547. count)))
  1548. (mapcar (lambda (id)
  1549. (funcall aurel-list-multi-download-function
  1550. (aurel-get-param-val
  1551. 'pkg-url (aurel-list-get-package-info id))
  1552. dir))
  1553. ids))
  1554. (funcall aurel-list-download-function
  1555. (aurel-get-param-val
  1556. 'pkg-url (aurel-list-get-package-info (car ids)))
  1557. dir))))
  1558. (defun aurel-list-sort (&optional n)
  1559. "Sort aurel list entries by the column at point.
  1560. With a numeric prefix argument N, sort the Nth column.
  1561. Same as `tabulated-list-sort', but also restore marks after sorting."
  1562. (interactive "P")
  1563. (let ((marks (mapcar #'car aurel-list-marks)))
  1564. (aurel-list-unmark-all)
  1565. (tabulated-list-sort n)
  1566. (when marks
  1567. (aurel-list-mark-packages marks))))
  1568. ;;; Marking packages
  1569. (defun aurel-list-marked-p (id)
  1570. "Return non-nil, if a package with ID is marked."
  1571. (assq id aurel-list-marks))
  1572. (defun aurel-list-mark ()
  1573. "Mark a package for downloading and move to the next line."
  1574. (interactive)
  1575. (let ((id (tabulated-list-get-id)))
  1576. (when (and id (not (aurel-list-marked-p id)))
  1577. (let ((overlay (make-overlay (line-beginning-position)
  1578. (line-end-position))))
  1579. (overlay-put overlay 'face 'aurel-list-marked)
  1580. (push (cons id overlay) aurel-list-marks)))
  1581. (forward-line)))
  1582. (defun aurel-list-mark-packages (ids)
  1583. "Mark specified packages.
  1584. IDS is a list of packages ID to mark. If IDS is t, mark all packages."
  1585. (save-excursion
  1586. (goto-char (point-min))
  1587. (while (not (= (point) (point-max)))
  1588. (if (or (eq ids t)
  1589. (member (tabulated-list-get-id) ids))
  1590. (aurel-list-mark)
  1591. (forward-line)))))
  1592. (defun aurel-list-mark-all ()
  1593. "Mark all packages for downloading."
  1594. (interactive)
  1595. (aurel-list-mark-packages t))
  1596. (defun aurel-list--unmark ()
  1597. "Unmark a package on the current line."
  1598. (let ((id (tabulated-list-get-id)))
  1599. (setq aurel-list-marks
  1600. (cl-delete-if (lambda (assoc)
  1601. (when (equal id (car assoc))
  1602. (delete-overlay (cdr assoc))
  1603. t))
  1604. aurel-list-marks))))
  1605. (defun aurel-list-unmark ()
  1606. "Unmark a package and move to the next line."
  1607. (interactive)
  1608. (aurel-list--unmark)
  1609. (forward-line))
  1610. (defun aurel-list-unmark-backward ()
  1611. "Move up one line and unmark a package on that line."
  1612. (interactive)
  1613. (forward-line -1)
  1614. (aurel-list--unmark))
  1615. (defun aurel-list-unmark-all ()
  1616. "Unmark all packages."
  1617. (interactive)
  1618. (dolist (assoc aurel-list-marks)
  1619. (delete-overlay (cdr assoc)))
  1620. (setq aurel-list-marks nil))
  1621. ;;; Filtering package list
  1622. (defun aurel-list-apply-filters (list &optional filters)
  1623. "Apply FILTERS to the LIST of packages.
  1624. LIST should have the form of `aurel-list'.
  1625. If FILTERS is nil, use `aurel-list-filters'.
  1626. Each package info from LIST is passed as an argument to the first
  1627. function from FILTERS, the returned result is passed to the
  1628. second function from that list and so on. If one of the FILTERS
  1629. returns nil, this package info is not passed (do not call the
  1630. rest filters in this case).
  1631. Return a list containing all passed packages info."
  1632. (if (setq filters (or filters aurel-list-filters))
  1633. (cl-remove-if-not
  1634. (lambda (package)
  1635. (aurel-apply-filters (cdr package) filters))
  1636. list)
  1637. list))
  1638. (defun aurel-list-apply-filter (filter &optional replace)
  1639. "Apply FILTER to the current package list and print results.
  1640. If REPLACE is nil, add FILTER to the existing ones; if it is
  1641. non-nil, remove other filters and make FILTER the only active
  1642. one."
  1643. (if replace
  1644. (setq aurel-list-filters (list filter))
  1645. (add-to-list 'aurel-list-filters filter))
  1646. (aurel-list-print))
  1647. (defun aurel-list-enable-filter (arg)
  1648. "Prompt for a function for filtering package list and call it.
  1649. Choose candidates from `aurel-list-available-filters'.
  1650. If ARG is non-nil (with prefix), make selected filter the only
  1651. active one (remove other filters)."
  1652. (interactive "P")
  1653. (let ((fun (intern (completing-read
  1654. (if current-prefix-arg
  1655. "Add filter: "
  1656. "Enable filter: ")
  1657. aurel-list-available-filters))))
  1658. (or (fboundp fun)
  1659. (error "Wrong function %s" fun))
  1660. (funcall fun arg)))
  1661. (defun aurel-list-disable-filters ()
  1662. "Disable all current filters and redisplay packages."
  1663. (interactive)
  1664. (setq aurel-list-filters nil)
  1665. (aurel-list-print))
  1666. (defun aurel-list-filter-maintained (arg)
  1667. "Filter current list by hiding maintained packages.
  1668. See `aurel-list-enable-filter' for the meaning of ARG."
  1669. (interactive "P")
  1670. (aurel-list-apply-filter
  1671. (lambda (info)
  1672. (unless (aurel-get-param-val 'maintainer info)
  1673. info))
  1674. arg))
  1675. (defun aurel-list-filter-unmaintained (arg)
  1676. "Filter current list by hiding unmaintained packages.
  1677. See `aurel-list-enable-filter' for the meaning of ARG."
  1678. (interactive "P")
  1679. (aurel-list-apply-filter
  1680. (lambda (info)
  1681. (when (aurel-get-param-val 'maintainer info)
  1682. info))
  1683. arg))
  1684. (defun aurel-list-filter-outdated (arg)
  1685. "Filter current list by hiding outdated packages.
  1686. See `aurel-list-enable-filter' for the meaning of ARG."
  1687. (interactive "P")
  1688. (aurel-list-apply-filter
  1689. (lambda (info)
  1690. (unless (aurel-get-param-val 'outdated info)
  1691. info))
  1692. arg))
  1693. (defun aurel-list-filter-not-outdated (arg)
  1694. "Filter current list by hiding not outdated packages.
  1695. See `aurel-list-enable-filter' for the meaning of ARG."
  1696. (interactive "P")
  1697. (aurel-list-apply-filter
  1698. (lambda (info)
  1699. (when (aurel-get-param-val 'outdated info)
  1700. info))
  1701. arg))
  1702. (defun aurel-list-filter-same-versions (arg)
  1703. "Hide packages with the same installed and available AUR versions.
  1704. See `aurel-list-enable-filter' for the meaning of ARG."
  1705. (interactive "P")
  1706. (aurel-list-apply-filter
  1707. (lambda (info)
  1708. (unless (equal (aurel-get-param-val 'version info)
  1709. (aurel-get-param-val 'installed-version info))
  1710. info))
  1711. arg))
  1712. (defun aurel-list-filter-different-versions (arg)
  1713. "Hide packages with different installed and available AUR versions.
  1714. See `aurel-list-enable-filter' for the meaning of ARG."
  1715. (interactive "P")
  1716. (aurel-list-apply-filter
  1717. (lambda (info)
  1718. (when (equal (aurel-get-param-val 'version info)
  1719. (aurel-get-param-val 'installed-version info))
  1720. info))
  1721. arg))
  1722. (defun aurel-list-filter-match-regexp (arg)
  1723. "Hide packages with names or descriptions matching prompted regexp.
  1724. See `aurel-list-enable-filter' for the meaning of ARG."
  1725. (interactive "P")
  1726. (let ((re (read-regexp "Hide packages matching regexp: ")))
  1727. (aurel-list-apply-filter
  1728. `(lambda (info)
  1729. (unless (or (string-match-p ,re (aurel-get-param-val 'name info))
  1730. (string-match-p ,re (aurel-get-param-val 'description info)))
  1731. info))
  1732. arg)))
  1733. (defun aurel-list-filter-not-match-regexp (arg)
  1734. "Hide packages with names or descriptions not matching prompted regexp.
  1735. See `aurel-list-enable-filter' for the meaning of ARG."
  1736. (interactive "P")
  1737. (let ((re (read-regexp "Hide packages not matching regexp: ")))
  1738. (aurel-list-apply-filter
  1739. `(lambda (info)
  1740. (when (or (string-match-p ,re (aurel-get-param-val 'name info))
  1741. (string-match-p ,re (aurel-get-param-val 'description info)))
  1742. info))
  1743. arg)))
  1744. ;;; Package info
  1745. (defgroup aurel-info nil
  1746. "Buffer with information about AUR package."
  1747. :group 'aurel)
  1748. (defface aurel-info-id
  1749. '((t))
  1750. "Face used for ID of a package."
  1751. :group 'aurel-info)
  1752. (defface aurel-info-name
  1753. '((t :inherit font-lock-keyword-face))
  1754. "Face used for a name of a package."
  1755. :group 'aurel-info)
  1756. (defface aurel-info-maintainer
  1757. '((t :inherit button))
  1758. "Face used for a maintainer of a package."
  1759. :group 'aurel-info)
  1760. (defface aurel-info-url
  1761. '((t :inherit button))
  1762. "Face used for URLs."
  1763. :group 'aurel-info)
  1764. (defface aurel-info-version
  1765. '((t :inherit font-lock-builtin-face))
  1766. "Face used for a version of a package."
  1767. :group 'aurel-info)
  1768. (defface aurel-info-keywords
  1769. '((t :inherit font-lock-comment-face))
  1770. "Face used for keywords of a package."
  1771. :group 'aurel-info)
  1772. (defface aurel-info-description
  1773. '((t))
  1774. "Face used for a description of a package."
  1775. :group 'aurel-info)
  1776. (defface aurel-info-license
  1777. '((t))
  1778. "Face used for a license of a package."
  1779. :group 'aurel-info)
  1780. (defface aurel-info-votes
  1781. '((t :weight bold))
  1782. "Face used for a number of votes of a package."
  1783. :group 'aurel-info)
  1784. (defface aurel-info-popularity
  1785. '((t))
  1786. "Face used for popularity of a package."
  1787. :group 'aurel-info)
  1788. (defface aurel-info-voted-mark
  1789. '((t :inherit aurel-info-voted))
  1790. "Face used for `aurel-info-voted-mark' string."
  1791. :group 'aurel-info)
  1792. (defface aurel-info-outdated
  1793. '((t :inherit font-lock-warning-face))
  1794. "Face used if a package is out of date."
  1795. :group 'aurel-info)
  1796. (defface aurel-info-not-outdated
  1797. '((t))
  1798. "Face used if a package is not out of date."
  1799. :group 'aurel-info)
  1800. (defface aurel-info-voted
  1801. '((default :weight bold)
  1802. (((class color) (min-colors 88) (background light))
  1803. :foreground "ForestGreen")
  1804. (((class color) (min-colors 88) (background dark))
  1805. :foreground "PaleGreen")
  1806. (((class color) (min-colors 8))
  1807. :foreground "green")
  1808. (t :underline t))
  1809. "Face used if a package is voted."
  1810. :group 'aurel-info)
  1811. (defface aurel-info-not-voted
  1812. '((t))
  1813. "Face used if a package is not voted."
  1814. :group 'aurel-info)
  1815. (defface aurel-info-subscribed
  1816. '((t :inherit aurel-info-voted))
  1817. "Face used if a package is subscribed."
  1818. :group 'aurel-info)
  1819. (defface aurel-info-not-subscribed
  1820. '((t :inherit aurel-info-not-voted))
  1821. "Face used if a package is not subscribed."
  1822. :group 'aurel-info)
  1823. (defface aurel-info-date
  1824. '((t :inherit font-lock-constant-face))
  1825. "Face used for dates."
  1826. :group 'aurel-info)
  1827. (defface aurel-info-size
  1828. '((t :inherit font-lock-variable-name-face))
  1829. "Face used for size of installed package."
  1830. :group 'aurel-info)
  1831. (defface aurel-info-architecture
  1832. '((t))
  1833. "Face used for 'Architecture' parameter."
  1834. :group 'aurel-info)
  1835. (defface aurel-info-provides
  1836. '((t :inherit font-lock-function-name-face))
  1837. "Face used for 'Provides' parameter."
  1838. :group 'aurel-info)
  1839. (defface aurel-info-replaces
  1840. '((t :inherit aurel-info-provides))
  1841. "Face used for 'Replaces' parameter."
  1842. :group 'aurel-info)
  1843. (defface aurel-info-conflicts
  1844. '((t :inherit aurel-info-provides))
  1845. "Face used for 'Conflicts With' parameter."
  1846. :group 'aurel-info)
  1847. (defface aurel-info-depends
  1848. '((t))
  1849. "Face used for 'Depends On' parameter."
  1850. :group 'aurel-info)
  1851. (defface aurel-info-depends-make
  1852. '((t))
  1853. "Face used for 'Make Deps' parameter."
  1854. :group 'aurel-info)
  1855. (defface aurel-info-depends-opt
  1856. '((t :inherit aurel-info-depends))
  1857. "Face used for 'Optional Deps' parameter."
  1858. :group 'aurel-info)
  1859. (defface aurel-info-required
  1860. '((t))
  1861. "Face used for 'Required By' parameter."
  1862. :group 'aurel-info)
  1863. (defface aurel-info-optional-for
  1864. '((t :inherit aurel-info-required))
  1865. "Face used for 'Optional For' parameter."
  1866. :group 'aurel-info)
  1867. (defcustom aurel-info-buffer-name "*AUR Package Info*"
  1868. "Default name of the buffer with information about an AUR package."
  1869. :type 'string
  1870. :group 'aurel-info)
  1871. (defcustom aurel-info-mode-name "AURel-Info"
  1872. "Default name of `aurel-info-mode', displayed in the mode line."
  1873. :type 'string
  1874. :group 'aurel-info)
  1875. (defcustom aurel-info-ignore-empty-vals t
  1876. "If nil, display empty values of package parameters.
  1877. Empty means non-existing (as returned by AUR API) or 'None' (as
  1878. returned by pacman) values.
  1879. See also `aurel-empty-string'."
  1880. :type 'boolean
  1881. :group 'aurel-info)
  1882. (defcustom aurel-info-format "%-16s: "
  1883. "String used to format a description of each package parameter.
  1884. It should be a '%s'-sequence. After inserting a description
  1885. formatted with this string, a value of the paramter is inserted."
  1886. :type 'string
  1887. :group 'aurel-info)
  1888. (defcustom aurel-info-fill-column 60
  1889. "Column used for filling (word wrapping) a description of a package.
  1890. This value does not include the length of a description of the
  1891. parameter, it is added to it; see `aurel-info-format'."
  1892. :type 'integer
  1893. :group 'aurel-info)
  1894. (defcustom aurel-info-download-function 'aurel-download-unpack-dired
  1895. "Function used for downloading AUR package from package info buffer.
  1896. It should accept 2 arguments: URL of a downloading file and a
  1897. destination directory."
  1898. :type (aurel-download-get-defcustom-type)
  1899. :group 'aurel-info)
  1900. (defcustom aurel-info-history-size 100
  1901. "Maximum number of items saved in history of package info buffer.
  1902. If 0, the history is disabled."
  1903. :type 'integer
  1904. :group 'aurel-info)
  1905. (defcustom aurel-info-voted-mark "*"
  1906. "String inserted after the number of votes in info buffer.
  1907. See `aurel-info-display-voted-mark' for details."
  1908. :type 'string
  1909. :group 'aurel-info)
  1910. (defcustom aurel-info-display-voted-mark t
  1911. "If non-nil, display `aurel-info-voted-mark' in info buffer.
  1912. It is displayed only if a package is voted by you (this
  1913. information is available if `aurel-aur-user-package-info-check'
  1914. is non-nil)."
  1915. :type 'boolean
  1916. :group 'aurel-info)
  1917. (defcustom aurel-info-installed-package-string
  1918. "\n\nThe package is installed:\n\n"
  1919. "String inserted in info buffer if a package is installed.
  1920. It is inserted after printing info from AUR and before info from pacman."
  1921. :type 'string
  1922. :group 'aurel-info)
  1923. (defcustom aurel-info-aur-user-string
  1924. "\n"
  1925. "String inserted before printing info specific for AUR user."
  1926. :type 'string
  1927. :group 'aurel-info)
  1928. (defcustom aurel-info-show-maintainer-account t
  1929. "If non-nil, display a link to maintainer's AUR account."
  1930. :type 'boolean
  1931. :group 'aurel-info)
  1932. (defvar aurel-info-insert-params-alist
  1933. '((id . aurel-info-id)
  1934. (base-id . aurel-info-id)
  1935. (name . aurel-info-name)
  1936. (base-name . aurel-info-name)
  1937. (maintainer . aurel-info-insert-maintainer)
  1938. (version . aurel-info-version)
  1939. (installed-version . aurel-info-version)
  1940. (keywords . aurel-info-keywords)
  1941. (license . aurel-info-license)
  1942. (votes . aurel-info-insert-votes)
  1943. (popularity . aurel-info-popularity)
  1944. (first-date . aurel-info-date)
  1945. (last-date . aurel-info-date)
  1946. (install-date . aurel-info-date)
  1947. (build-date . aurel-info-date)
  1948. (description . aurel-info-description)
  1949. (outdated . aurel-info-insert-outdated)
  1950. (voted . aurel-info-insert-voted)
  1951. (subscribed . aurel-info-insert-subscribed)
  1952. (pkg-url . aurel-info-insert-url)
  1953. (home-url . aurel-info-insert-url)
  1954. (aur-url . aurel-info-insert-aur-url)
  1955. (base-url . aurel-info-insert-base-url)
  1956. (architecture . aurel-info-architecture)
  1957. (provides . aurel-info-provides)
  1958. (installed-provides . aurel-info-provides)
  1959. (replaces . aurel-info-replaces)
  1960. (installed-replaces . aurel-info-replaces)
  1961. (conflicts . aurel-info-conflicts)
  1962. (installed-conflicts . aurel-info-conflicts)
  1963. (depends . aurel-info-depends)
  1964. (installed-depends . aurel-info-depends)
  1965. (depends-make . aurel-info-depends-make)
  1966. (depends-opt . aurel-info-depends-opt)
  1967. (required . aurel-info-required)
  1968. (optional-for . aurel-info-optional-for)
  1969. (installed-size . aurel-info-size))
  1970. "Alist for parameters inserted into info buffer.
  1971. Car of each assoc is a symbol from `aurel-param-description-alist'.
  1972. Cdr is a symbol for inserting a value of a parameter. If the
  1973. symbol is a face name, it is used for the value; if it is a function,
  1974. it is called with the value of the parameter.")
  1975. (defvar aurel-info-parameters
  1976. '(name version maintainer description home-url aur-url base-url
  1977. provides depends-make depends conflicts replaces
  1978. license keywords votes popularity outdated first-date last-date)
  1979. "List of parameters displayed in package info buffer.
  1980. Each parameter should be a symbol from `aurel-param-description-alist'.
  1981. The order of displayed parameters is the same as in this list.
  1982. If nil, display all parameters with no particular order.")
  1983. (defvar aurel-info-installed-parameters
  1984. '(installed-version architecture installed-size installed-provides
  1985. installed-depends depends-opt required optional-for
  1986. installed-conflicts installed-replaces packager
  1987. build-date install-date script validated)
  1988. "List of parameters of an installed package displayed in info buffer.
  1989. Each parameter should be a symbol from `aurel-param-description-alist'.
  1990. The order of displayed parameters is the same as in this list.
  1991. If nil, display all parameters with no particular order.")
  1992. (defvar aurel-info-aur-user-parameters
  1993. '(voted subscribed)
  1994. "List of parameters specific for AUR user displayed in info buffer.
  1995. Each parameter should be a symbol from `aurel-param-description-alist'.
  1996. The order of displayed parameters is the same as in this list.
  1997. If nil, display all parameters with no particular order.")
  1998. (defvar aurel-info nil
  1999. "Alist with package info.
  2000. Car of each assoc is a symbol from `aurel-param-description-alist'.
  2001. Cdr - is a value of that parameter.")
  2002. (defvar aurel-info-mode-map
  2003. (let ((map (make-sparse-keymap)))
  2004. (set-keymap-parent map (make-composed-keymap button-buffer-map
  2005. special-mode-map))
  2006. (define-key map (kbd "d") 'aurel-info-download-package)
  2007. (define-key map (kbd "l") 'aurel-history-back)
  2008. (define-key map (kbd "r") 'aurel-history-forward)
  2009. (define-key map (kbd "v") 'aurel-info-vote-unvote)
  2010. (define-key map (kbd "s") 'aurel-info-subscribe-unsubscribe)
  2011. map)
  2012. "Keymap for `aurel-info-mode'.")
  2013. (defun aurel-info-get-buffer-name (&optional unique)
  2014. "Return a name of an info buffer.
  2015. If UNIQUE is non-nil, make the name unique."
  2016. (if unique
  2017. (generate-new-buffer aurel-info-buffer-name)
  2018. aurel-info-buffer-name))
  2019. (define-derived-mode aurel-info-mode special-mode aurel-info-mode-name
  2020. "Major mode for displaying information about an AUR package.
  2021. \\{aurel-info-mode-map}"
  2022. (make-local-variable 'aurel-info)
  2023. (make-local-variable 'aurel-revert-action)
  2024. (setq-local revert-buffer-function 'aurel-revert-buffer)
  2025. (setq-local aurel-history-size aurel-info-history-size)
  2026. (setq default-directory aurel-download-directory))
  2027. (defun aurel-info-show (info &optional buffer)
  2028. "Display package information INFO in BUFFER.
  2029. INFO should have the form of `aurel-info'.
  2030. If BUFFER is nil, use (create if needed) buffer with the name
  2031. `aurel-info-buffer-name'."
  2032. (let ((buf (get-buffer-create
  2033. (or buffer aurel-info-buffer-name))))
  2034. (with-current-buffer buf
  2035. (aurel-info-show-in-current-buffer info))
  2036. (pop-to-buffer-same-window buf)))
  2037. (defun aurel-info-show-in-current-buffer (info)
  2038. "Display package information INFO in current buffer.
  2039. INFO should have the form of `aurel-info'."
  2040. (aurel-info-mode)
  2041. (setq aurel-info info)
  2042. (let ((inhibit-read-only t))
  2043. (erase-buffer)
  2044. (apply 'aurel-info-print
  2045. info aurel-info-parameters)
  2046. (when (assoc 'voted info)
  2047. (insert aurel-info-aur-user-string)
  2048. (apply 'aurel-info-print
  2049. info aurel-info-aur-user-parameters))
  2050. (when (aurel-get-param-val 'installed-name info)
  2051. (insert aurel-info-installed-package-string)
  2052. (apply 'aurel-info-print
  2053. info aurel-info-installed-parameters)))
  2054. (goto-char (point-min)))
  2055. (defun aurel-info-print (info &rest params)
  2056. "Insert (pretty print) package INFO into current buffer.
  2057. Each element from PARAMS is a parameter to insert (symbol from
  2058. `aurel-param-description-alist')."
  2059. (mapc (lambda (param)
  2060. (aurel-info-print-param info param))
  2061. params))
  2062. (defun aurel-info-print-param (info param)
  2063. "Insert description and value of an INFO parameter PARAM at point.
  2064. PARAM is a symbol from `aurel-param-description-alist'.
  2065. Use `aurel-info-format' to format descriptions of parameters."
  2066. (let* ((param-assq (assq param info))
  2067. (val (if param-assq
  2068. (cdr param-assq)
  2069. aurel-none-string))
  2070. (insert-val (cdr (assq param aurel-info-insert-params-alist)))
  2071. (insert-fun? (functionp insert-val)))
  2072. (unless (and aurel-info-ignore-empty-vals
  2073. (not insert-fun?)
  2074. (or (null param-assq)
  2075. (equal val aurel-none-string)))
  2076. (insert (format aurel-info-format
  2077. (aurel-get-param-description param)))
  2078. (if insert-fun?
  2079. (funcall insert-val val)
  2080. (aurel-info-insert-val
  2081. val (and (facep insert-val) insert-val)))
  2082. (insert "\n"))))
  2083. (defun aurel-info-insert-votes (votes)
  2084. "Insert the number of VOTES at point.
  2085. If `aurel-info-display-voted-mark' is non-nil, insert
  2086. `aurel-info-voted-mark' after."
  2087. (aurel-info-insert-val votes 'aurel-info-votes)
  2088. (and aurel-info-display-voted-mark
  2089. (aurel-get-param-val 'voted aurel-info)
  2090. (aurel-info-insert-val aurel-info-voted-mark
  2091. 'aurel-info-voted-mark)))
  2092. (defun aurel-info-insert-maintainer (name)
  2093. "Make button from maintainer NAME and insert it at point."
  2094. (if (null name)
  2095. (insert aurel-empty-string)
  2096. (insert-button
  2097. name
  2098. 'face 'aurel-info-maintainer
  2099. 'action (lambda (btn)
  2100. (aurel-maintainer-search (button-label btn)
  2101. current-prefix-arg))
  2102. 'follow-link t
  2103. 'help-echo "mouse-2, RET: Find the packages by this maintainer")
  2104. (when aurel-info-show-maintainer-account
  2105. (insert "\n"
  2106. (format aurel-info-format ""))
  2107. (aurel-info-insert-url (aurel-get-maintainer-account-url name)))))
  2108. (defun aurel-info-insert-aur-url (_)
  2109. "Insert URL of the AUR package."
  2110. (aurel-info-insert-url
  2111. (aurel-get-aur-package-url
  2112. (aurel-get-param-val 'name aurel-info))))
  2113. (defun aurel-info-insert-base-url (_)
  2114. "Insert URL of the AUR package base."
  2115. (aurel-info-insert-url
  2116. (aurel-get-package-base-url
  2117. (aurel-get-param-val 'base-name aurel-info))))
  2118. (defun aurel-info-insert-url (url)
  2119. "Make button from URL and insert it at point."
  2120. (insert-button
  2121. url
  2122. 'face 'aurel-info-url
  2123. 'action (lambda (btn) (browse-url (button-label btn)))
  2124. 'follow-link t
  2125. 'help-echo "mouse-2, RET: Browse URL"))
  2126. (defun aurel-info-insert-boolean (val &optional t-face nil-face)
  2127. "Insert boolean value VAL at point.
  2128. If VAL is nil, use NIL-FACE, otherwise use T-FACE."
  2129. (let ((face (if val t-face nil-face)))
  2130. (insert (aurel-get-string val face))))
  2131. (defun aurel-info-insert-outdated (val)
  2132. "Insert value VAL of the `outdated' parameter at point."
  2133. (aurel-info-insert-boolean
  2134. val 'aurel-info-outdated 'aurel-info-not-outdated))
  2135. (defun aurel-info-insert-voted (val)
  2136. "Insert value VAL of the `voted' parameter at point."
  2137. (aurel-info-insert-boolean
  2138. val 'aurel-info-voted 'aurel-info-not-voted))
  2139. (defun aurel-info-insert-subscribed (val)
  2140. "Insert value VAL of the `subscribed' parameter at point."
  2141. (aurel-info-insert-boolean
  2142. val 'aurel-info-subscribed 'aurel-info-not-subscribed))
  2143. (defun aurel-info-get-filled-string (str col)
  2144. "Return string by filling a string STR.
  2145. COL controls the width for filling."
  2146. (with-temp-buffer
  2147. (insert str)
  2148. (let ((fill-column col)) (fill-region (point-min) (point-max)))
  2149. (buffer-string)))
  2150. (defun aurel-info-insert-strings (strings &optional face)
  2151. "Insert STRINGS at point.
  2152. Each string is inserted on a new line after an empty string
  2153. formatted with `aurel-info-format'.
  2154. If FACE is non-nil, propertize inserted lines with this FACE."
  2155. (dolist (str strings)
  2156. (insert "\n"
  2157. (format aurel-info-format "")
  2158. (aurel-get-string str face))))
  2159. (defun aurel-info-insert-val (val &optional face)
  2160. "Format and insert parameter value VAL at point.
  2161. If VAL is string longer than `aurel-info-fill-column', convert it
  2162. into several shorter lines.
  2163. If FACE is non-nil, propertize inserted line(s) with this FACE."
  2164. (if (stringp val)
  2165. (let ((strings (split-string val "\n *")))
  2166. (and (null (cdr strings)) ; if not multi-line
  2167. (> (length val) aurel-info-fill-column)
  2168. (setq strings
  2169. (split-string (aurel-info-get-filled-string
  2170. val aurel-info-fill-column)
  2171. "\n")))
  2172. (insert (aurel-get-string (car strings) face))
  2173. (aurel-info-insert-strings (cdr strings) face))
  2174. (insert (aurel-get-string val face))))
  2175. (defun aurel-info-download-package ()
  2176. "Download current package.
  2177. With prefix, prompt for a directory with `aurel-directory-prompt'
  2178. to save the package; without prefix, save to
  2179. `aurel-download-directory' without prompting.
  2180. Use `aurel-info-download-function'."
  2181. (interactive)
  2182. (or (derived-mode-p 'aurel-info-mode)
  2183. (user-error "Current buffer is not in aurel-info-mode"))
  2184. (let ((dir (if current-prefix-arg
  2185. (read-directory-name aurel-directory-prompt
  2186. aurel-download-directory)
  2187. aurel-download-directory)))
  2188. (funcall aurel-info-download-function
  2189. (aurel-get-param-val 'pkg-url aurel-info)
  2190. dir)))
  2191. (defun aurel-info-aur-user-action (action &optional norevert)
  2192. "Perform AUR user ACTION on the current package.
  2193. ACTION is a symbol from `aurel-aur-user-actions'.
  2194. If NOREVERT is non-nil, do not revert the buffer (i.e. do not
  2195. refresh package information) after ACTION."
  2196. (and (aurel-aur-user-action
  2197. action (aurel-get-param-val 'base-name aurel-info))
  2198. (null norevert)
  2199. (revert-buffer nil t)))
  2200. (defun aurel-info-vote-unvote (arg)
  2201. "Vote for the current package.
  2202. With prefix (if ARG is non-nil), unvote."
  2203. (interactive "P")
  2204. (aurel-info-aur-user-action (if arg 'unvote 'vote)))
  2205. (defun aurel-info-subscribe-unsubscribe (arg)
  2206. "Subscribe to the new comments of the current package.
  2207. With prefix (if ARG is non-nil), unsubscribe."
  2208. (interactive "P")
  2209. (aurel-info-aur-user-action (if arg 'unsubscribe 'subscribe)))
  2210. (provide 'aurel)
  2211. ;;; aurel.el ends here