cgit.sxemacs.org Git - packages/blob - xemacs-packages/speedbar/rpm.el

   1 ;;; rpm.el --- Manage Red Hat packages in emacs
   2
   3 ;;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Version: 1.0
   7 ;; Keywords: speedbar, rpm
   8 ;; X-RCS: $Id: rpm.el,v 1.11 2005/09/30 20:25:46 zappo Exp $
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; Manage Red Hat system packages in emacs.  Uses speedbar to display
  30 ;; the package higherarchy, and defines an `rpm-mode' which is useful
  31 ;; for managing and viewing a specific package.
  32 ;;
  33 ;;  This tool depends on speedbar version 0.7 or higher.
  34 ;;
  35
  36 ;;; History:
  37 ;;
  38 ;; 1.0  Initial revision
  39
  40 (require 'speedbar)
  41 ;;; Code:
  42
  43 (defvar rpm-system nil
  44   "This represents the current system.")
  45
  46 (defvar rpm-speedbar-key-map nil
  47   "Keymap used when working with RPMs in speedbar.")
  48
  49 (if rpm-speedbar-key-map
  50     nil
  51   (setq rpm-speedbar-key-map (speedbar-make-specialized-keymap))
  52
  53   ;; General viewing pleasure...
  54   (define-key rpm-speedbar-key-map "\C-m" 'speedbar-edit-line)
  55   (define-key rpm-speedbar-key-map "+" 'speedbar-expand-line)
  56   (define-key rpm-speedbar-key-map "=" 'speedbar-expand-line)
  57   (define-key rpm-speedbar-key-map "-" 'speedbar-contract-line)
  58
  59   )
  60
  61 (defvar rpm-speedbar-menu
  62   ()
  63   "Menu part in easymenu format that is used in speedbar while in rpm mode.")
  64
  65 (defvar rpm-font-lock-keywords
  66   '(
  67     ;; file names
  68     ("^\\(/[^ \n]+\\)$" 1 font-lock-reference-face)
  69     ;; Tags
  70     ("\\(Name\\|Version\\|Release\\|Install date\\|Group\\|Size\\|Packager\\|\
  71 Summary\\|Description\\|Distribution\\|Vendor\\|Build Date\\|Build Host\\|\
  72 Source RPM\\|URL\\) *:" 0 font-lock-variable-name-face)
  73     ("^Name +: \\([^ \t]+\\)" 1 font-lock-function-name-face)
  74     ;; Everything else is from the description.
  75     ;; This is a clever font lock hack since it wont double color items
  76     ("^\\([^\n]+\\)$" 1 font-lock-comment-face)
  77     )
  78   "Keywords used to highlight an RPM info buffer.")
  79
  80 (defun rpm-info (package)
  81   "View RPM PACKAGE information in the current buffer."
  82   (interactive "sPackage: ")
  83   (toggle-read-only -1)
  84   (call-process "rpm" nil t nil "-qil" package)
  85   (goto-char (point-min))
  86   (rpm-mode)
  87   (set-buffer-modified-p nil)
  88   (toggle-read-only 1))
  89
  90 (defun rpm-mode ()
  91   "Major mode for viewing package information."
  92   (interactive)
  93   (kill-all-local-variables)
  94   (setq major-mode 'rpm-mode
  95         mode-name "RPM")
  96   (make-local-variable 'font-lock-defaults)
  97   (setq font-lock-defaults '((rpm-font-lock-keywords)
  98                              t t
  99                              ((?_ . "w") (?/ . "w"))))
 100   (run-hooks 'rpm-info-hook))
 101
 102 ;;;###autoload
 103 (defun rpm ()
 104   "Red Hat Package Management in Emacs."
 105   (interactive)
 106   ;; Make sure that speedbar is active
 107   (speedbar-frame-mode 1)
 108   ;; Make sure our special speedbar major mode is loaded
 109   (speedbar-add-expansion-list '("rpm" rpm-speedbar-menu rpm-speedbar-key-map
 110                                  rpm-speedbar))
 111   ;; Now, throw us into RPM mode on speedbar.
 112   (speedbar-change-initial-expansion-list "rpm")
 113   )
 114
 115 (defun rpm-speedbar (directory zero)
 116   "Create buttons in speedbar that represents the current rpm system.
 117 Takes DIRECTORY and ZERO, which are both ignored."
 118   (rpm-fetch-system)
 119   (let ((speedbar-tag-hierarchy-method '(speedbar-sort-tag-hierarchy)))
 120     (speedbar-insert-generic-list -1 rpm-system 'rpm-tag-expand 'rpm-tag-find)))
 121
 122 (defun rpm-tag-expand (text token indent)
 123   "Expand a tag sublist.  Imenu will return sub-lists of specialized tag types.
 124 Etags does not support this feature.  TEXT will be the button
 125 string.  TOKEN will be the list, and INDENT is the current indentation
 126 level."
 127   (cond ((string-match "+" text)        ;we have to expand this file
 128          (speedbar-change-expand-button-char ?-)
 129          (speedbar-with-writable
 130            (save-excursion
 131              (end-of-line) (forward-char 1)
 132              (let ((speedbar-tag-hierarchy-method '(speedbar-sort-tag-hierarchy)))
 133                (speedbar-insert-generic-list indent
 134                                              token
 135                                              'rpm-tag-expand
 136                                              'rpm-tag-find)))))
 137         ((string-match "-" text)        ;we have to contract this node
 138          (speedbar-change-expand-button-char ?+)
 139          (speedbar-delete-subblock indent))
 140         (t (error "Ooops... not sure what to do.")))
 141   (speedbar-center-buffer-smartly))
 142
 143 (defun rpm-tag-find (text token indent)
 144   "When clicking on a found tag, open that RPM file up.
 145 TEXT is the name of the package.  TOKEN and INDENT are ignored."
 146   (let* ((buff (get-buffer-create text))
 147          (bwin (get-buffer-window buff 0)))
 148     (if bwin
 149         (progn
 150           (select-window bwin)
 151           (raise-frame (window-frame bwin)))
 152       (if dframe-power-click
 153           (let ((pop-up-frames t)) (select-window (display-buffer buff)))
 154         (dframe-select-attached-frame speedbar-frame)
 155         (switch-to-buffer buff)))
 156     (erase-buffer)
 157     (rpm-info text)))
 158
 159 (defun rpm-fetch-system ()
 160   "Fetch the system by executing rpm."
 161   (if rpm-system
 162       nil
 163     (save-excursion
 164       (set-buffer (get-buffer-create "*rpm output*"))
 165       ;; Get the database information here
 166       (if (= (point-min) (point-max))
 167           (progn
 168             (speedbar-message "Running rpm -qa")
 169             (call-process "rpm" nil t nil "-qa" "--queryformat"
 170                           "%{name}-%{version}-%{release} %{group}\n")))
 171       ;; Convert it into a giant list
 172       (speedbar-message "Parsing output ... ")
 173       (goto-char (point-min))
 174       (while (re-search-forward "^\\([^ ]+\\) \\([^\n]+\\)$" nil t)
 175         (let* ((n (match-string 1))
 176                (p (match-string 2))
 177                (sl nil))
 178           ;; Start the directory listing
 179           (string-match "^\\([^/]+\\)\\(/\\|$\\)" p)
 180           (setq sl (assoc (match-string 1 p) rpm-system))
 181           (if (not sl) (setq rpm-system
 182                              (cons (setq sl (list (match-string 1 p)))
 183                                    rpm-system)))
 184           (setq p (substring p (match-end 0)))
 185           ;; Loop to the end of the directory listing
 186           (while (string-match "^\\([^/]+\\)\\(/\\|$\\)" p)
 187             (let ((ssl (assoc (match-string 1 p) sl)))
 188               (if (not ssl)
 189                   (setcdr sl (cons (setq ssl (list (match-string 1 p)))
 190                                    (cdr sl))))
 191               (setq sl ssl))
 192             (setq p (substring p (match-end 0))))
 193           ;; We are at the end.  Append our new element to the end
 194           (while (cdr sl) (setq sl (cdr sl)))
 195           (setcdr sl (cons (cons n 1) nil)))))))
 196
 197 (provide 'rpm)
 198 ;;; rpm.el ends here