;; pkgusr.el --- elisp tools for LFS pkgusr package management -*- Emacs-Lisp -*-
-;; Copyright (C) 2007 Steve Youngs
+;; Copyright (C) 2007 - 2014 Steve Youngs
;; Author: Steve Youngs <steve@sxemacs.org>
;; Maintainer: Steve Youngs <steve@sxemacs.org>
;; Created: <2007-07-13>
-;; Time-stamp: <Wednesday Mar 12, 2014 17:01:00 steve>
+;; Time-stamp: <Sunday Mar 16, 2014 01:10:12 steve>
;; Homepage: N/A
;; Keywords: utils package-management
;;; Todo:
;;
-;;
-
-;;; ChangeLog:
+;; o Reduce code duplication through use of macros
+;; o View build logs
+;; o Run builds
;;
-;; This is just a place holder so `pkgusr-commentary' will work
-;; properly. See the ChangeLog file for changes.
;;; Code:
(defvar pkgusr-pkg-history nil
(defun pkgusr-all-pkgs ()
"Return a list of all installed packages."
(let ((lst (with-temp-buffer
- (erase-buffer)
(insert-file-contents "/etc/group")
(re-search-forward "^install:x:9999:" nil t)
(narrow-to-region (point) (point-at-eol))
(split-string-by-char (buffer-string) ?,))))
lst))
-(defun pkgusr-pkgs-count ()
- "Return the number of installed packages."
- (length (pkgusr-all-pkgs)))
+(defvar pkgusr-all-pkgs (pkgusr-all-pkgs)
+ "A list of all installed packages.")
+
+(defun pkgusr-all-pkgs-update ()
+ "Update the list of installed packages."
+ (setq pkgusr-all-pkgs (pkgusr-all-pkgs)))
+
+(defun pkgusr-pkgs-count (&optional upd-list)
+ "Return the number of installed packages.
+
+With optional argument UPD-LIST force an update of the packages list."
+ (and upd-list
+ (pkgusr-all-pkgs-update))
+ (length pkgusr-all-pkgs))
-(defun pkgusr-list-pkgs-regexp (regexp)
- "Return a list of packages matching REGEXP."
- (interactive "sRegexp: ")
- (let ((pkgs (pkgusr-all-pkgs))
- (case-fold-search t)
+(defun pkgusr-list-pkgs-regexp (regexp &optional upd-list)
+ "Return a list of packages matching REGEXP.
+
+With 1 prefix arg insert the result into the current buffer at point.
+With 2 prefix args force update of the packages list.
+With 3 prefix args force update and insert into buffer.
+
+With optional argument UPD-LIST, force update of the packages list."
+ (interactive "sRegexp: \np")
+ (and (or (eq upd-list 16)
+ (eq upd-list 64))
+ (pkgusr-all-pkgs-update))
+ (let ((case-fold-search t)
res)
(mapcar
#'(lambda (pkg)
(when (string-match regexp pkg)
- (push pkg res)))
- pkgs)
+ (setq res (append res (list pkg)))))
+ pkgusr-all-pkgs)
(if (interactive-p)
- (message "%S" (nreverse res))
- (nreverse res))))
+ (cond
+ ((or (eq upd-list 4)
+ (eq upd-list 64))
+ (insert (mapconcat #'identity res " ")))
+ (t
+ (message "[Matches for \"%s\"]: %s" regexp
+ (mapconcat #'identity res " "))))
+ res)))
(defconst pkgusr-url-regexp
(concat
(set-extent-property extent 'balloon-help echo)
(set-extent-property extent 'duplicable t)))))
-(defun pkgusr-show-pkg (&optional pkg)
- "Display a buffer of package details for PKG."
- (interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Show Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (buf (get-buffer-create (format "*Package Details: %s*" pkg)))
- (detail (shell-command-to-string (format "pinky -l %s" pkg))))
+(defun pkgusr-pkg-details (pkg)
+ (let ((buf (get-buffer-create (format "*Package Details: %s*" pkg)))
+ (detail (shell-command-to-string (format "pinky -l %s" pkg))))
(with-current-buffer buf
(erase-buffer)
(insert detail)
(kill-buffer b)
(pop-window-configuration)))))
-(defun pkgusr-pkg-install-notes (&optional pkg)
- "Display the install notes of a PKG."
+(defun pkgusr-show-pkg ()
+ "Display filelist and other details for a package.
+
+With a prefix arg, force update of the packages list."
+ (interactive)
+ (and current-prefix-arg
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (completing-read "Show Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ (pkgusr-pkg-details pkg)))
+
+(defun pkgusr-pkg-install-notes ()
+ "Display the install notes of a package.
+
+With a prefix arg, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Show Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- start end)
- (pkgusr-show-pkg pkg)
+ (and current-prefix-arg
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history))
+ start end)
+ (pkgusr-pkg-details pkg)
(re-search-forward "^Install Notes:$" nil t)
(setq start (point-at-bol))
(re-search-forward "^General Notes:$" nil t)
(narrow-to-region start end)
(goto-char (point-min))))
-(defun pkgusr-pkg-general-notes (&optional pkg)
- "Display the general notes of a PKG."
+(defun pkgusr-pkg-general-notes ()
+ "Display the general notes of a package.
+
+With a prefix arg, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Show Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- start end)
- (pkgusr-show-pkg pkg)
+ (and current-prefix-arg
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history))
+ start end)
+ (pkgusr-pkg-details pkg)
(re-search-forward "^General Notes:$" nil t)
(setq start (point-at-bol))
(re-search-forward "^CONTENTS:$" nil t)
(narrow-to-region start end)
(goto-char (point-min))))
+;;; FIXME: doesn't work for sub-groups.
(defun pkgusr-cmd-pkg (cmd)
"Display the package name \(user:group\) which contains CMD.
+With a prefix arg, insert into the current buffer at point.
+
If non-interactive, return a list whose car is user and cdr is group."
(interactive "sCommand: ")
- (unless (executable-find cmd)
- (error 'pkgusr-unknown-cmd cmd))
- (let* ((cmd (executable-find cmd))
+ (let* ((cmd (or (executable-find cmd)
+ (error 'pkgusr-unknown-cmd cmd)))
(user (user-login-name
(nth 2 (file-attributes cmd))))
(group (user-login-name
(nth 3 (file-attributes cmd)))))
+ (unless (or (member user pkgusr-all-pkgs)
+ (member group pkgusr-all-pkgs))
+ (error 'pkgusr-unknown-pkg user))
(if (interactive-p)
- (message "Command: %s is from the \"%s\" package \(%s:%2$s\)"
- cmd group user)
+ (if current-prefix-arg
+ (insert (format "%s: (%s:%s)" cmd user group))
+ (message "Command: %s is from the \"%s\" package (%2$s:%s)"
+ cmd user group))
(list user group))))
(defun pkgusr-file-pkg (file)
"Display the pkg name \(user:group\) which contains FILE.
+With a prefix arg, insert into current buffer at point.
+
If non-interactive, return a list whose car is user and cdr is group."
(interactive "fFile: ")
- (let* ((user (user-login-name
- (nth 2 (file-attributes file))))
- (group (user-login-name
- (nth 3 (file-attributes file)))))
- (if (member user (pkgusr-all-pkgs))
- (if (interactive-p)
- (message "File: %s is from the \"%s\" package \(%s:%2$s\)"
- file group user)
- (list user group))
- (error 'pkgusr-unknown-file file))))
-
-(defun pkgusr-pkg-url (&optional pkg)
- "Return the URL of PKG as a string."
+ (let ((user (user-login-name
+ (nth 2 (file-attributes file))))
+ (group (user-login-name
+ (nth 3 (file-attributes file)))))
+ (unless (or (member user pkgusr-all-pkgs)
+ (member group pkgusr-all-pkgs))
+ (error 'pkgusr-unknown-pkg user))
+ (if (interactive-p)
+ (if current-prefix-arg
+ (insert (format "%s: (%s:%s)" file user group))
+ (message "File: %s is from the \"%s\" package (%2$s:%s)"
+ file user group)
+ (list user group)))))
+
+(defun pkgusr-project-file (pkg)
+ "Return the .project file for PKG."
+ (let ((dir (paths-construct-path (list "/usr" "src" pkg))))
+ (expand-file-name ".project" dir)))
+
+(defun pkgusr-pkg-url (&optional pkg upd-list)
+ "Return the URL of PKG as a string.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (pkgfile (format "/usr/src/%s/.project" pkg)))
- (when (member pkg allpkgs)
- (with-temp-buffer
- (erase-buffer)
- (insert-file-contents pkgfile)
- (goto-char (point-min))
- (re-search-forward "Web_Site: <\\(.*\\)>$" nil t)
- (if (interactive-p)
- (message "[%s URL] %s" pkg (match-string 1))
- (match-string 1))))))
-
-(defun pkgusr-pkg-repo (&optional pkg)
- "Return the repo URI of PKG as a string."
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg
+ (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ url)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (with-temp-buffer
+ (insert-file-contents (pkgusr-project-file pkg))
+ (goto-char (point-min))
+ (re-search-forward "Web_Site: <\\(.*\\)>$" nil t)
+ (setq url (match-string 1)))
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert url))
+ (t
+ (message "[URL (%s)]: %s" pkg url)))
+ url)))
+
+(defun pkgusr-pkg-repo (&optional pkg upd-list)
+ "Return the repo URI of PKG as a string.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (pkgfile (format "/usr/src/%s/.project" pkg))
- repo type)
- (when (member pkg allpkgs)
- (with-temp-buffer
- (erase-buffer)
- (insert-file-contents pkgfile)
- (goto-char (point-min))
- (re-search-forward "Repo_Type: <?\\(.*\\)>?$" nil t)
- (setq type (match-string 1))
- (re-search-forward "Repo_Location: <\\(.*\\)>" nil t)
- (setq repo (match-string 1)))
- (if (interactive-p)
- (message "[%s Repo] %s (%s)" pkg repo type)
- repo))))
-
-(defun pkgusr-pkg-version (&optional pkg)
- "Return the version of PKG as a string."
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ repo type)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (with-temp-buffer
+ (insert-file-contents (pkgusr-project-file pkg))
+ (goto-char (point-min))
+ (re-search-forward "Repo_Type: <\\(.*\\)>$" nil t)
+ (setq type (match-string 1))
+ (re-search-forward "Repo_Location: <\\(.*\\)>" nil t)
+ (setq repo (match-string 1)))
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert repo))
+ (t
+ (message "[Repo (%s)]: %s (%s)" pkg repo type)))
+ repo)))
+
+(defun pkgusr-pkg-version (&optional pkg upd-list)
+ "Return the version of PKG as a string.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (pkgfile (format "/usr/src/%s/.project" pkg)))
- (if (member pkg allpkgs)
- (with-temp-buffer
- (erase-buffer)
- (insert-file-contents pkgfile)
- (goto-char (point-min))
- (re-search-forward "Version: \\(.*$\\)" nil t)
- (if (interactive-p)
- (message "[%s Ver] %s" pkg (match-string 1))
- (match-string 1)))
- (error 'pkgusr-unknown-pkg pkg))))
-
-(defun pkgusr-pkg-description (&optional pkg)
- "Return the description of PKG as a string."
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ version)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (with-temp-buffer
+ (insert-file-contents (pkgusr-project-file pkg))
+ (goto-char (point-min))
+ (re-search-forward "Version: \\(.*$\\)" nil t)
+ (setq version (match-string 1)))
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert version))
+ (t
+ (message "[Version (%s)]: %s" pkg version)))
+ version)))
+
+(defun pkgusr-pkg-description (&optional pkg upd-list)
+ "Return the description of PKG as a string.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (pkgfile (format "/usr/src/%s/.project" pkg)))
- (if (member pkg allpkgs)
- (with-temp-buffer
- (erase-buffer)
- (insert-file-contents pkgfile)
- (goto-char (point-min))
- (re-search-forward "Description: \\(.*$\\)" nil t)
- (if (interactive-p)
- (message "[%s Desc] %s" pkg (match-string 1))
- (match-string 1)))
- (error 'pkgusr-unknown-pkg pkg))))
-
-(defun pkgusr-pkg-deps (&optional pkg)
- "Return the dependencies of PKG as a string."
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ desc)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (with-temp-buffer
+ (insert-file-contents (pkgusr-project-file pkg))
+ (goto-char (point-min))
+ (re-search-forward "Description: \\(.*$\\)" nil t)
+ (setq desc (match-string 1)))
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert desc))
+ (t
+ (message "[Description (%s)]: %s" pkg desc)))
+ desc)))
+
+(defun pkgusr-pkg-deps (&optional pkg upd-list)
+ "Return a list of dependencies of PKG.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
(interactive)
- (let* ((allpkgs (pkgusr-all-pkgs))
- (pkg (or pkg (completing-read "Package: "
- (mapcar #'list allpkgs)
- nil t nil pkgusr-pkg-history)))
- (pkgfile (format "/usr/src/%s/.project" pkg)))
- (if (member pkg allpkgs)
- (with-temp-buffer
- (erase-buffer)
- (insert-file-contents pkgfile)
- (goto-char (point-min))
- (re-search-forward "Deps: \\(.*$\\)" nil t)
- (if (interactive-p)
- (message "[%s Deps] %s" pkg (match-string 1))
- (match-string 1)))
- (error 'pkgusr-unknown-pkg pkg))))
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ deps)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (with-temp-buffer
+ (insert-file-contents (pkgusr-project-file pkg))
+ (goto-char (point-min))
+ (re-search-forward "Deps: \\(.*$\\)" nil t)
+ (setq deps (match-string 1)))
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert deps))
+ (t
+ (message "[Deps (%s)]: %s" pkg deps)))
+ (split-string-by-char deps ?\ ))))
+
+;;; FIXME: This churns like you wouldn't believe, can we make it more
+;;; efficient?
+(defun pkgusr-pkg-rdeps (&optional pkg upd-list)
+ "Return a list of packages which cite PKG as a dependency.
+
+With 1 prefix arg, insert into current buffer at point.
+With 2 prefix args, force update of the packages list.
+With 3 prefix args, force update and insert into buffer.
+With optional arg UPD-LIST, force update of the packages list."
+ (interactive)
+ (and (or (eq (car current-prefix-arg) 16)
+ (eq (car current-prefix-arg) 64)
+ upd-list)
+ (pkgusr-all-pkgs-update))
+ (let ((pkg (or pkg (completing-read "Package: "
+ (mapcar #'list pkgusr-all-pkgs)
+ nil t nil pkgusr-pkg-history)))
+ result)
+ (unless (member pkg pkgusr-all-pkgs)
+ (error 'pkgusr-unknown-pkg pkg))
+ (mapcar
+ #'(lambda (maybe-pkg)
+ (let ((deplist (pkgusr-pkg-deps maybe-pkg)))
+ (mapcar
+ #'(lambda (dep)
+ (and (string-match pkg dep)
+ (setq result (append result (list maybe-pkg)))))
+ deplist)))
+ pkgusr-all-pkgs)
+ (sort result #'string<)
+ (if (interactive-p)
+ (cond
+ ((or (eq (car current-prefix-arg) 4)
+ (eq (car current-prefix-arg) 64))
+ (insert (mapconcat #'identity result " ")))
+ (t
+ (message "[Reverse Deps (%s)]: %s" pkg
+ (mapconcat #'identity result " "))))
+ result)))
;; A little bogus perhaps, but it works. `pkgusr-find-file' is
;; something that only I can use because it ssh's through root to
(defvar-when-pkgmgr pkgusr-file-history nil
"History for pkgusr-find-file.")
-(defun-when-pkgmgr pkgusr-find-file (pkgusr file)
- "Using Tramp, find PKGUSR's FILE."
- (interactive "i\ni")
+(defun-when-pkgmgr pkgusr-find-file (&optional pkgusr file)
+ "Using Tramp, find PKGUSR's FILE.
+
+With a prefix arg, force update of the packages list."
+ (interactive)
(unless (interactive-p)
(error 'invalid-operation "Trying to call interactive-only command"))
- (let* ((allpkgs (pkgusr-all-pkgs))
- (puser (completing-read "Package User: "
- (mapcar #'list allpkgs)
+ (and current-prefix-arg
+ (pkgusr-all-pkgs-update))
+ (let* ((puser (completing-read "Package User: "
+ (mapcar #'list pkgusr-all-pkgs)
nil t nil pkgusr-pkg-history))
(file (read-file-name (format "[%s] find file: " puser)
(file-name-as-directory
(global-set-key [(hyper c) g] #'pkgusr-pkg-general-notes)
(global-set-key [(hyper c) i] #'pkgusr-pkg-install-notes)
(global-set-key [(hyper c) r] #'pkgusr-pkg-repo)
+(global-set-key [(hyper c) R] #'pkgusr-pkg-rdeps)
(global-set-key [(hyper c) u] #'pkgusr-pkg-url)
(global-set-key [(hyper c) v] #'pkgusr-pkg-version)
(global-set-key [(hyper c) s] #'pkgusr-show-pkg)
projects / pkgusr / commitdiff