diff options
Diffstat (limited to 'apt-utils.el')
| -rw-r--r-- | apt-utils.el | 974 |
1 files changed, 974 insertions, 0 deletions
diff --git a/apt-utils.el b/apt-utils.el new file mode 100644 index 0000000..873b6ca --- /dev/null +++ b/apt-utils.el @@ -0,0 +1,974 @@ +;;; apt-utils.el --- Emacs interface to APT (Debian package management) + +;;; Copyright (C) 2002, 03 Matthew P. Hodges + +;; Author: Matthew P. Hodges <matt@tc.bham.ac.uk> +;; $Id$ + +;; apt-utils.el is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; apt-utils.el is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;;; Commentary: +;; +;; Package to interface Emacs with APT. Start things off using e.g.: +;; M-x apt-utils-show-package RET emacs21 RET +;; +;; Other packages (dependencies, conflicts etc) can be navigated using +;; apt-utils-{next,previous}-package, apt-utils-choose-package-link or +;; apt-utils-follow-link. Return to the previous package with +;; apt-utils-view-previous-package. ChangeLog and README files for the +;; current package can easily be accessed with, for example, +;; apt-utils-view-changelog. +;; +;; For normal (i.e., not virtual) packages, the information can be +;; toggled between `package' and `showpkg' displays using +;; apt-utils-toggle-package-info; the latter is useful for the +;; "Reverse Depends". +;; +;; View the key bindings with describe-mode (bound to ? by default). + +;;; Code: + +(require 'cl) ; for set-difference + +(unless (fboundp 'puthash) + (if (fboundp 'cl-puthash) + (defalias 'puthash 'cl-puthash) + (error "No puthash function known"))) + +;; Customizable variables + +(defcustom apt-utils-fill-packages t + "*Fill APT package names if t." + :group 'apt-utils + :type 'boolean) + +(defcustom apt-utils-show-link-info t + "*Show APT package descriptions when cycling through links if t." + :group 'apt-utils + :type 'boolean) + +;; Faces + +(defface apt-utils-normal-package-face + '((((class color) (background light)) + (:foreground "purple")) + (((class color) (background dark)) + (:foreground "yellow"))) + "Face used for APT hyperlinks." + :group 'apt-utils) + +(defface apt-utils-virtual-package-face + '((((class color) (background light)) + (:foreground "green4")) + (((class color) (background dark)) + (:foreground "green"))) + "Face used for APT hyperlinks." + :group 'apt-utils) + +;; Other variables + +(defvar apt-utils-apt-cache-program "/usr/bin/apt-cache" + "Location of the apt-cache program.") + +(defvar apt-utils-dpkg-program "/usr/bin/dpkg" + "Location of the dpkg program.") + +(defvar apt-utils-grep-dctrl-program "/usr/bin/grep-dctrl" + "Location of the grep-dctrl program.") + +(defvar apt-utils-grep-dctrl-file-list + (directory-files "/var/lib/apt/lists" t "_Packages") + "List of files searched by `apt-utils-search-grep-dctrl'.") + +(defvar apt-utils-package-list nil + "List of packages known to APT.") + +(defvar apt-utils-virtual-package-list nil + "List of virtual packages known to APT.") + +(defvar apt-utils-package-hashtable nil + "Hash table containing APT packages types.") + +(defvar apt-utils-package-lists-built nil + "Whether or not APT package lists are built.") + +(defvar apt-utils-current-packages nil + "Packages associated with the *APT package info* buffer.") +(make-variable-buffer-local 'apt-utils-current-packages) + +(defvar apt-utils-current-links nil + "Package links associated with the *APT package info* buffer.") +(make-variable-buffer-local 'apt-utils-current-links) + +(defvar apt-utils-buffer-positions nil + "Cache of positions associated with current packages. +These are stored in a hash table.") +(make-variable-buffer-local 'apt-utils-buffer-positions) + +(defvar apt-utils-dired-buffer nil + "Keep track of dired buffer.") + +;; XEmacs support + +(defconst apt-utils-xemacs-p + (or (featurep 'xemacs) + (string-match "XEmacs\\|Lucid" (emacs-version))) + "True if we are using apt-utils under XEmacs.") + +;; Commands and functions + +;;;###autoload +(defun apt-utils-show-package (&optional arg) + "Write APT package information to buffer. +With ARG, choose that package, otherwise prompt for one." + (interactive) + (let ((buffer "*APT package info*") + package type) + ;; If ARG is provided, the car is the package name and the cdr the + ;; package type + (cond ((and (not (null arg)) (listp arg)) + (setq package (car arg)) + (setq type (cdr arg))) + ((stringp arg) + (setq package arg)) + (t + (setq package (apt-utils-choose-package)))) + ;; Type might not be known yet + (unless type + (setq type (apt-utils-package-type package))) + ;; Set up the buffer + (if (get-buffer buffer) + (set-buffer buffer) + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode) + (setq truncate-lines nil)) + ;; If called interactively, initialize apt-utils-current-packages + (when (interactive-p) + (setq apt-utils-current-packages (cons (cons package type) nil)) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal)))) + (let ((inhibit-read-only t)) + (erase-buffer) + (cond + ((equal type 'normal) + (call-process apt-utils-apt-cache-program nil t nil "show" package) + ;; Remove old versions + (goto-char (point-min)) + (re-search-forward "^$") + (unless (eobp) + (delete-region (point) (point-max))) + (apt-utils-add-package-links)) + ;; Virtual package or normal package w/ showpkg + ((or (equal type 'virtual) (equal type 'normal-showpkg)) + (call-process apt-utils-apt-cache-program nil t nil "showpkg" package) + (apt-utils-add-showpkg-links)) + ;; Normal search + ((equal type 'search) + (insert (format "Debian package search for %s\n\n" package)) + (call-process apt-utils-apt-cache-program nil t nil "search" package) + (apt-utils-add-search-links)) + ;; Search for names only + ((equal type 'search-names-only) + (insert (format "Debian package search (names only) for %s\n\n" package)) + (call-process apt-utils-apt-cache-program nil t nil + "search" "--names-only" package) + (apt-utils-add-search-links)) + ((equal type 'search-grep-dctrl) + (insert (format "grep-dctrl search for %s\n\n" + (concat (format "\"%s\" " (car package)) + (mapconcat 'identity (cdr package) " ")))) + (apply 'call-process apt-utils-grep-dctrl-program nil t nil package) + (apt-utils-add-package-links)))) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (display-buffer buffer))) + +(defun apt-utils-list-package-files () + "List the files associated with the current package. +Only works for installed packages; uses `apt-utils-dpkg-program'." + (interactive) + (let ((package (caar apt-utils-current-packages)) files) + (with-temp-buffer + (insert "(setq files '(\n") + (call-process apt-utils-dpkg-program nil t nil "-L" package) + (insert "))") + ;; Check for files + (cond + ((or (search-backward "does not contain any files" nil t) + (search-backward "is not installed" nil t)) + (message "Package does not contain any files/is not installed")) + (t + (eval-buffer) + (setq files + (delq nil + (mapcar (lambda (elt) + (if (or (file-regular-p (symbol-name elt)) + (string-equal "/." (symbol-name elt))) + (symbol-name elt) + nil)) + files))) + ;; Some versions of Emacs won't update dired for the same + ;; directory name if it already exists + (if (buffer-live-p apt-utils-dired-buffer) + (kill-buffer apt-utils-dired-buffer)) + (setq apt-utils-dired-buffer (dired-noselect files)) + (display-buffer apt-utils-dired-buffer)))))) + +(defun apt-utils-search (&optional arg) + "Search Debian packages for regular expression. +With ARG, match names only." + (interactive "p") + (let ((buffer "*APT package info*") + (regexp (read-from-minibuffer "Search packages for regexp: "))) + ;; Set up the buffer + (if (get-buffer buffer) + (set-buffer buffer) + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode) + (setq truncate-lines nil)) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "Debian package search for %s\n\n" regexp)) + (cond + (current-prefix-arg + (call-process apt-utils-apt-cache-program nil t nil + "search" regexp "--names-only") + (setq apt-utils-current-packages (cons (cons regexp 'search-names-only) nil))) + (t + (call-process apt-utils-apt-cache-program nil t nil "search" regexp) + (setq apt-utils-current-packages (cons (cons regexp 'search) nil)))) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal))) + (apt-utils-add-search-links) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (display-buffer buffer)))) + +(defun apt-utils-search-grep-dctrl () + "Search Debian packages for regular expression using grep-dctrl." + (interactive) + (let (args + (buffer "*APT package info*") + (fields (read-from-minibuffer "Search package fields: ")) + (show (read-from-minibuffer "Show package fields: ")) + (regexp (read-from-minibuffer "Search regexp: "))) + (if (get-buffer buffer) + (set-buffer buffer) + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode) + (setq truncate-lines nil)) + (let ((inhibit-read-only t)) + (erase-buffer) + ;; Construct argument list (need to keep this) + (setq args (append (list regexp fields show) + apt-utils-grep-dctrl-file-list)) + (insert (format "grep-dctrl search for %s\n\n" + (mapconcat + (lambda (elt) + (if (string-equal regexp elt) + (format "\"%s\"" regexp) + elt)) + args " "))) + (apply 'call-process + apt-utils-grep-dctrl-program nil t nil args) + (setq apt-utils-current-packages (cons (cons args 'search-grep-dctrl) nil)) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal))) + (apt-utils-add-package-links) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (display-buffer buffer)))) + +(defun apt-utils-toggle-package-info () + "Toggle between package and showpkg info for normal packages." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((package (caar apt-utils-current-packages)) + (type (cdar apt-utils-current-packages)) + posn) + (cond + ((equal type 'normal) + (setq posn (apt-utils-update-buffer-positions 'toggle)) + (setq apt-utils-current-packages + (cons (cons package 'normal-showpkg) + (cdr apt-utils-current-packages))) + (apt-utils-show-package (car apt-utils-current-packages)) + (goto-char posn)) + ((equal type 'normal-showpkg) + (setq posn (apt-utils-update-buffer-positions 'toggle)) + (setq apt-utils-current-packages + (cons (cons package 'normal) + (cdr apt-utils-current-packages))) + (apt-utils-show-package (car apt-utils-current-packages)) + (goto-char posn)) + ((equal type 'virtual) + (message "Cannot toggle info for virtual packages.")) + ((or (equal type 'search) + (equal type 'search-names-only) + (equal type 'search-grep-dctrl)) + (message "Cannot toggle info for searches."))))) + +;; Find ChangeLog files + +(defun apt-utils-view-changelog () + "Find ChangeLog for current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer")) + ((not (equal (cdar apt-utils-current-packages) 'normal)) + (message "Not a normal package")) + (t + (let ((package (caar apt-utils-current-packages))) + (apt-utils-view-changelog-file package))))) + +(defun apt-utils-view-changelog-file (package) + "Find ChangeLog file for PACKAGE." + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/changelog" package) + '("" ".gz")))) + (if file + (apt-utils-view-file file) + (message "No ChangeLog file found for %s." package)))) + +;; Find Debian ChangeLog files + +(defun apt-utils-view-debian-changelog () + "Find Debian ChangeLog for current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer")) + ((not (equal (cdar apt-utils-current-packages) 'normal)) + (message "Not a normal package")) + (t + (let ((package (caar apt-utils-current-packages))) + (apt-utils-view-debian-changelog-file package))))) + +(defun apt-utils-view-debian-changelog-file (package) + "Find Debian ChangeLog file for PACKAGE." + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/changelog.Debian" package) + '("" ".gz")))) + (if file + (apt-utils-view-file file) + (message "No Debian ChangeLog file found for %s." package)))) + +;; Find README files + +(defun apt-utils-view-readme () + "Find README for current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer")) + ((not (equal (cdar apt-utils-current-packages) 'normal)) + (message "Not a normal package")) + (t + (let ((package (caar apt-utils-current-packages))) + (apt-utils-view-readme-file package))))) + +(defun apt-utils-view-readme-file (package) + "Find README file for PACKAGE." + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/README" package) + '("" ".gz")))) + (if file + (apt-utils-view-file file) + (message "No README file found for %s." package)))) + +;; Find Debian README files + +(defun apt-utils-view-debian-readme () + "Find Debian README for current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer")) + ((not (equal (cdar apt-utils-current-packages) 'normal)) + (message "Not a normal package")) + (t + (let ((package (caar apt-utils-current-packages))) + (apt-utils-view-debian-readme-file package))))) + +(defun apt-utils-view-debian-readme-file (package) + "Find Debian README file for PACKAGE." + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/README" package) + '(".Debian" ".Debian.gz" ".debian" ".debian.gz")))) + (if file + (apt-utils-view-file file) + (message "No Debian README file found for %s." package)))) + +(defun apt-utils-find-readable-file (root suffixes) + "Find a readable file composed of ROOT and one of SUFFIXES." + (catch 'found + (mapcar (lambda (suffix) + (when (file-readable-p (concat root suffix)) + (throw 'found (concat root suffix)))) + suffixes) + nil)) ; Return nil, if no file found + +(defun apt-utils-view-file (file) + "View ChangeLog or README information in FILE." + (cond ((string-match "\\.gz$" file) + (if (fboundp 'with-auto-compression-mode) + (with-auto-compression-mode + (view-file file)) + (auto-compression-mode 1) + (view-file file))) + (t + (view-file file)))) + +;; Follow hyperlinks + +(defun apt-utils-follow-link () + "Follow hyperlink at point." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((package + (cadr + (member 'apt-package (text-properties-at (point)))))) + (apt-utils-follow-link-internal package))) + +(defun apt-utils-mouse-follow-link (event) + "Follow hyperlink at mouse click. +Argument EVENT is a mouse event." + (interactive "e") + (let (package posn) + ;; Mouse may be in a different window, i.e. buffer + (setq posn + (cond + ((fboundp 'posn-point) + (posn-point (event-start event))) + ((fboundp 'event-point) + (event-point event)) + (t + (error "Cannot determine event position")))) + (set-buffer (window-buffer + (cond + ((fboundp 'posn-window) + (posn-window (event-start event))) + ((fboundp 'event-window) + (event-window event)) + (t + (error "Cannot determine event window"))))) + (setq package + (cadr + (member 'apt-package (text-properties-at + posn)))) + (apt-utils-follow-link-internal package))) + +(defun apt-utils-follow-link-internal (package) + "Follow hyperlink for PACKAGE." + (if package + (progn + (apt-utils-update-buffer-positions 'forward) + (apt-utils-show-package package) + (setq apt-utils-current-packages + (cons (cons package (apt-utils-package-type package)) + apt-utils-current-packages))) + (message "No known package at point."))) + +;; Go to previous package in list + +(defun apt-utils-view-previous-package () + "Go back to previous package displayed." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (if (cdr apt-utils-current-packages) + (progn + (let ((posn (apt-utils-update-buffer-positions 'backward))) + (apt-utils-show-package (cadr apt-utils-current-packages)) + (goto-char posn)) + (setq apt-utils-current-packages (cdr apt-utils-current-packages))) + (message "No previous packages."))) + +;; Adapted from widget-move + +(defun apt-utils-next-package (&optional arg) + "Move point to the ARG next package. +ARG may be negative to move backward." + (interactive "p") + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (cond + ;; No links + ((null apt-utils-current-links) + (message "No package links.")) + ;; One link + ((= (length apt-utils-current-links) 1) + (goto-char (point-min)) + (goto-char (next-single-property-change (point) + 'apt-package))) + (t + (let ((pos (point)) + (number arg) + (old (apt-utils-package-at)) + new) + ;; Forward. + (while (> arg 0) + (cond ((eobp) + (goto-char (point-min))) + (t + (goto-char (or (next-single-property-change + (point) 'apt-package) + (point-max))))) + (let ((new (apt-utils-package-at))) + (when new + (unless (eq new old) + (setq arg (1- arg)) + (setq old new))))) + ;; Backward. + (while (< arg 0) + (cond ((bobp) + (goto-char (point-max))) + (t + (goto-char (or (previous-single-property-change + (point) 'apt-package) + (point-min))))) + (let ((new (apt-utils-package-at))) + (when new + (unless (eq new old) + (setq arg (1+ arg)))))) + ;; Go to beginning of field. + (let ((new (apt-utils-package-at))) + (while (eq (apt-utils-package-at) new) + (backward-char))) + (forward-char)))) + ;; Echo some info + (when apt-utils-show-link-info + (apt-utils-package-at-message))) + +(defun apt-utils-previous-package (&optional arg) + "Move point to the ARG previous package. +ARG may be negative to move forward." + (interactive "p") + (apt-utils-next-package (- arg))) + +;; Choose a package from the known links + +(defun apt-utils-choose-package-link () + "Choose a Debian package from the list of known links." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((package + (completing-read "Choose related Debian package: " + (mapcar (lambda (elt) + (cons elt elt)) + apt-utils-current-links) nil t))) + (when (> (length package) 0) + (apt-utils-update-buffer-positions 'forward) + (apt-utils-show-package package) + (setq apt-utils-current-packages + (cons (cons package (apt-utils-package-type package)) + apt-utils-current-packages))))) + +(defun apt-utils-package-list () + "Return list of known Debian packages." + (unless apt-utils-package-lists-built + (apt-utils-build-package-lists)) + apt-utils-package-list) + +(defun apt-utils-virtual-package-list () + "Return list of known Debian packages." + (unless apt-utils-package-lists-built + (apt-utils-build-package-lists)) + apt-utils-virtual-package-list) + +(defun apt-utils-build-package-lists (&optional force) + "Build list of Debian packages known to APT. +With optional argument FORCE, rebuild list even if it is non-nil." + (when (or force (null apt-utils-package-list)) + (unwind-protect + (progn + (setq apt-utils-package-lists-built nil) + (message "Building Debian package lists...") + ;; All packages except virtual ones + (with-temp-buffer + (insert "(setq apt-utils-package-list '(\n") + (call-process apt-utils-apt-cache-program nil t nil "pkgnames" + ;; Don't get virtual packages + "-o" "APT::Cache::AllNames=0") + (insert "))") + (eval-buffer)) + ;; Virtual packages (difference between all, and all minus + ;; virtual unfortunately) + (with-temp-buffer + (insert "(setq apt-utils-virtual-package-list '(\n") + (call-process apt-utils-apt-cache-program nil t nil "pkgnames") + (insert "))") + (eval-buffer)) + ;; Find the difference + (setq apt-utils-virtual-package-list + (set-difference apt-utils-virtual-package-list + apt-utils-package-list)) + ;; Massage (for use with completing read) + (setq apt-utils-package-list + (mapcar (lambda (elt) + (cons (downcase (symbol-name elt)) nil)) + apt-utils-package-list)) + (setq apt-utils-virtual-package-list + (mapcar (lambda (elt) + (cons (downcase (symbol-name elt)) nil)) + apt-utils-virtual-package-list)) + ;; Hash table listing package types + (if (hash-table-p apt-utils-package-hashtable) + (clrhash apt-utils-package-hashtable)) + (setq apt-utils-package-hashtable (make-hash-table :test 'equal)) + (mapcar (lambda (elt) + (puthash (downcase (car elt)) 'normal apt-utils-package-hashtable)) + apt-utils-package-list) + (mapcar (lambda (elt) + (puthash (downcase (car elt)) 'virtual apt-utils-package-hashtable)) + apt-utils-virtual-package-list) + (message "Building Debian package lists...done") + (setq apt-utils-package-lists-built t)) + (unless apt-utils-package-lists-built + (message "Building Debian package lists...interrupted") + (setq apt-utils-package-list nil + apt-utils-virtual-package-list nil) + (if (hash-table-p apt-utils-package-hashtable) + (clrhash apt-utils-package-hashtable)))))) + +(defun apt-utils-choose-package () + "Choose a Debian package from list." + (completing-read "Choose Debian package: " + (append (apt-utils-package-list) + (apt-utils-virtual-package-list)) + nil t)) + +;; Add hyperlinks + +(defun apt-utils-add-package-links () + "Add hyperlinks to related Debian packages." + (let ((keywords '("Conflicts" "Depends" "Pre-Depends" "Package" + "Provides" "Recommends" "Replaces" "Suggests")) + keywords-maxlen regexp) + (when apt-utils-fill-packages + (setq keywords-maxlen + (car + (sort + (mapcar + (lambda (elt) + ;; Search for header + (goto-char (point-min)) + (if (re-search-forward (concat "^" elt ": ") nil t) + (length elt) + 0) + ) keywords) #'>)))) + (setq apt-utils-current-links nil) + (while keywords + (setq regexp (concat "^" (car keywords) ": ")) + (goto-char (point-min)) + (while (re-search-forward regexp (point-max) t) + ;; Padding + (when apt-utils-fill-packages + (insert + (make-string (- keywords-maxlen (length (car keywords))) ? ))) + ;; Find packages + (let ((packages + ;; Packages split by commas, or alternatives by + ;; vertical bars + (split-string (buffer-substring + (point) + ;; (line-end-position)) + (save-excursion + (end-of-line) + (point))) + " ?[,|] ?")) + (inhibit-read-only t) + face + length length-no-version + package) + (while packages + (setq package (car packages)) + (setq length (length package)) + ;; Remove version info (in parenthesis), and whitespace + (setq package + (cond + ((fboundp 'replace-regexp-in-string) + (replace-regexp-in-string "\\((.*)\\|\\s-+\\)" "" package)) + ((fboundp 'replace-in-string) + (replace-in-string package "\\((.*)\\|\\s-+\\)" "")) + ((and (require 'dired) + (fboundp 'dired-replace-in-string)) + (dired-replace-in-string "\\((.*)\\|\\s-+\\)" "" package)) + (t + (error "No replace in string function")))) + (setq length-no-version (length package)) + ;; Package type + (cond + ((equal (apt-utils-package-type package) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type package) 'virtual) + (setq face 'apt-utils-virtual-package-face))) + ;; Add text properties + (add-text-properties (point) (+ (point) length-no-version) + `(face ,face + mouse-face highlight + apt-package ,package)) + ;; Fill package names + (and apt-utils-fill-packages + (> (current-column) (+ 2 keywords-maxlen)) + (> (+ (current-column) length) fill-column) + (insert "\n" (make-string (+ 2 keywords-maxlen) ? ))) + ;; Store list of unique package links + (unless (member package apt-utils-current-links) + (setq apt-utils-current-links + (cons package apt-utils-current-links))) + (forward-char length) + (skip-chars-forward ", |") + (setq packages (cdr packages))))) + (setq keywords (cdr keywords))))) + +(defun apt-utils-add-showpkg-links () + "Add hyperlinks to related Debian packages." + (let ((keywords '("Reverse Depends" "Reverse Provides")) + (inhibit-read-only t) + start end regexp face link) + (setq apt-utils-current-links nil) + (while keywords + (setq regexp (concat "^" (car keywords) ": ")) + (goto-char (point-min)) + (when (re-search-forward regexp (point-max) t) + ;; Limits of search + (setq start (1+ (point))) + (setq end (or (re-search-forward "[a-z]:" (point-max) t) + (point-max))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (not (eobp)) + (when (or (looking-at "^\\s-+\\(.*\\),") + (looking-at "^\\(.*\\) ")) + (setq link (match-string 1)) + ;; Store list of unique package links + (setq apt-utils-current-links + (cons link apt-utils-current-links)) + (cond + ((equal (apt-utils-package-type link) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type link) 'virtual) + (setq face 'apt-utils-virtual-package-face))) + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,face + mouse-face highlight + apt-package ,link))) + (forward-line)))) + (setq keywords (cdr keywords))))) + +(defun apt-utils-add-search-links () + "Add hyperlinks to related Debian packages." + (let ((inhibit-read-only t) + start end face link) + (setq apt-utils-current-links nil) + (goto-char (point-min)) + (forward-line 2) ; Move past header + (while (re-search-forward "^\\([^ ]+\\) - " (point-max) t) + (setq link (match-string 1)) + ;; Store list of unique package links + (when + (not (member link apt-utils-current-links)) + (setq apt-utils-current-links + (cons link apt-utils-current-links))) + (cond + ((equal (apt-utils-package-type link) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type link) 'virtual) + (setq face 'apt-utils-virtual-package-face))) + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,face + mouse-face highlight + apt-package ,link))))) + +(defun apt-utils-package-type (package) + "Return what type of package PACKAGE is." + (unless apt-utils-package-lists-built + (apt-utils-build-package-lists)) + (or (gethash package apt-utils-package-hashtable) + (error "Unknown type for package \"%s\"" package))) + +(defun apt-utils-package-at () + "Get package at point." + (get-text-property (point) 'apt-package)) + +(defun apt-utils-package-at-message () + "Emit message describing package at point." + (let ((package (apt-utils-package-at))) + (if package + (with-temp-buffer + (call-process apt-utils-apt-cache-program nil t nil "show" package) + (if (re-search-backward "^Description: \\(.*\\)$" (point-min) t) + (message "%s: %s" package (match-string 1)) + (message "%s: virtual package (no description)." + package)))))) + +(defun apt-utils-quit () + "Quit the *APT package info* buffer." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (if (fboundp 'quit-window) + (quit-window) + (bury-buffer))) + +;; Track positions + +(defun apt-utils-update-buffer-positions (type) + "Update `apt-utils-buffer-positions'. +TYPE can be forward, backward, or toggle." + (let (posn) + (cond + ((eq type 'forward) + ;; Make the key unique; we could visit the same package more + ;; than once + (puthash (format "%s/%s/%d" + (caar apt-utils-current-packages) + (cdar apt-utils-current-packages) + (length apt-utils-current-packages)) + (point) + apt-utils-buffer-positions)) + ((eq type 'backward) + ;; Remove old values + (remhash (format "%s/normal/%d" + (caar apt-utils-current-packages) + (length apt-utils-current-packages)) + apt-utils-buffer-positions) + (remhash (format "%s/normal-showpkg/%d" + (caar apt-utils-current-packages) + (length apt-utils-current-packages)) + apt-utils-buffer-positions) + (remhash (format "%s/virtual/%d" + (caar apt-utils-current-packages) + (length apt-utils-current-packages)) + apt-utils-buffer-positions) + ;; Get position for previous package + (setq posn + (gethash (format "%s/%s/%d" + (caadr apt-utils-current-packages) + (cdadr apt-utils-current-packages) + (1- (length apt-utils-current-packages))) + apt-utils-buffer-positions))) + ((eq type 'toggle) + ;; new/old package types + (let ((package (caar apt-utils-current-packages)) + (type (cdar apt-utils-current-packages)) + new old) + (if (equal type 'normal) + (setq old 'normal + new 'normal-showpkg) + (setq old 'normal-showpkg + new 'normal)) + ;; Set position for old entry + (puthash (format "%s/%s/%d" + package + old + (length apt-utils-current-packages)) + (point) + apt-utils-buffer-positions) + ;; Get position for new entry + (setq posn + (gethash (format "%s/%s/%d" + package + new + (length apt-utils-current-packages)) + apt-utils-buffer-positions + 1)) ; default value + ))) + posn)) + +;; Mode settings + +(defvar apt-utils-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "1") 'delete-other-windows) + (define-key map (kbd "?") 'describe-mode) + (define-key map (kbd "<") 'apt-utils-view-previous-package) + (define-key map (kbd ">") 'apt-utils-choose-package-link) + (define-key map (kbd "c") 'apt-utils-view-changelog) + (define-key map (kbd "C") 'apt-utils-view-debian-changelog) + (define-key map (kbd "q") 'apt-utils-quit) + (define-key map (kbd "l") 'apt-utils-list-package-files) + (define-key map (kbd "r") 'apt-utils-view-readme) + (define-key map (kbd "R") 'apt-utils-view-debian-readme) + (define-key map (kbd "s") 'apt-utils-show-package) + (define-key map (kbd "S") 'apt-utils-search) + (define-key map (kbd "t") 'apt-utils-toggle-package-info) + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "DEL") 'scroll-down) + (define-key map (kbd "RET") 'apt-utils-follow-link) + (define-key map (kbd "TAB") 'apt-utils-next-package) + (define-key map (kbd "M-TAB") 'apt-utils-previous-package) + (if apt-utils-xemacs-p + (define-key map '(button2) 'apt-utils-mouse-follow-link) + (define-key map (kbd "<mouse-2>") 'apt-utils-mouse-follow-link)) + map) + "Keymap for apt-utils mode.") + +;; Menus + +(defvar apt-utils-menu nil + "Menu to use for `apt-utils-mode'.") + +(when (fboundp 'easy-menu-define) + + (easy-menu-define apt-utils-menu apt-utils-mode-map "Apt Utils Menu" + '("Apt Utils" + "---" + ["Show Package" apt-utils-show-package t] + ["View Previous Package" apt-utils-view-previous-package t] + ["Choose Package Link" apt-utils-choose-package-link t] + ["Next Package" apt-utils-next-package t] + ["Previous Package" apt-utils-previous-package t] + ["Follow Link" apt-utils-follow-link t] + ["Search" apt-utils-search t] + "---" + ["View ChangeLog" apt-utils-view-changelog t] + ["View Debian ChangeLog" apt-utils-view-debian-changelog t] + ["View README" apt-utils-view-readme t] + ["View Debian README" apt-utils-view-debian-readme t] + "---" + ["List Package Files" apt-utils-list-package-files t] + ["Toggle Package Info" apt-utils-toggle-package-info t] + "---" + ["Quit" apt-utils-quit t]))) + +(defun apt-utils-mode () + "Major mode for controlling the *APT package info* buffer. + +\\{apt-utils-mode-map}" + (kill-all-local-variables) + (use-local-map apt-utils-mode-map) + (setq major-mode 'apt-utils-mode) + (setq mode-name "APT utils") + (when (and (fboundp 'easy-menu-add) + apt-utils-menu) + (easy-menu-add apt-utils-menu)) + (run-hooks 'apt-utils-mode-hook)) + +(provide 'apt-utils) + +;;; apt-utils.el ends here |