aurel.el 91 KB

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