emacs_el/tiny-tools/tiny/tinydebian.el

   1 ;;; tinydebian.el --- Debian utilities.
   2
   3 ;;{{{ Id
   4
   5 ;; Copyright (C)    2001-2007 Jari Aalto
   6 ;; Keywords:        extensions
   7 ;; Author:          Jari Aalto
   8 ;; Maintainer:      Jari Aalto
   9 ;;
  10 ;; To get information on this program, call M-x tinydebian-version.
  11 ;; Look at the code with folding.el
  12
  13 ;; COPYRIGHT NOTICE
  14 ;;
  15 ;; This program is free software; you can redistribute it and/or modify it
  16 ;; under the terms of the GNU General Public License as published by the Free
  17 ;; Software Foundation; either version 2 of the License, or (at your option)
  18 ;; any later version.
  19 ;;
  20 ;; This program is distributed in the hope that it will be useful, but
  21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  22 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  23 ;; for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with program; see the file COPYING. If not, write to the
  27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  28 ;; Boston, MA 02110-1301, USA.
  29 ;;
  30 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  31
  32 ;;}}}
  33 ;;{{{ Install
  34
  35 ;; ........................................................ &t-install ...
  36 ;;   Put this file on your Emacs-Lisp load path, add following into your
  37 ;;   $HOME/.emacs startup file
  38 ;;
  39 ;;      (add-hook 'tinydebian-:load-hook 'tinydebian-install)
  40 ;;      (require 'tinydebian)
  41 ;;
  42 ;;   If you have any about this Emacs package:
  43 ;;
  44 ;;      M-x tinydebian-submit-bug-report    send question, feedback, bugs
  45 ;;
  46 ;;  To read the documentation after file has been loaded, call
  47 ;;
  48 ;;      M-x tinydebian-version
  49
  50 ;;}}}
  51 ;;{{{ Documentation
  52
  53 ;; ..................................................... &t-commentary ...
  54
  55 ;;; Commentary:
  56
  57 ;;  Overview of features
  58 ;;
  59 ;;      This package contains utilities for the Debian System Administarator,
  60 ;;      to help administring Debian in daily tasks and submitting bug
  61 ;;      reports from Emacs. Learn more about debian at
  62 ;;      http://www.debian.org/
  63 ;;
  64 ;;      o   colorize /var/log files like messages, syslog etc.
  65 ;;      o   Report Debian bug with M-x ... #todo
  66 ;;
  67 ;;  Quick start:
  68 ;;
  69 ;;      To report bug to Debian package, like command line reportbug(1):
  70 ;;
  71 ;;          M-x tinydebian-reportbug
  72
  73 ;;}}}
  74
  75 ;;; Change Log:
  76
  77 ;;; Code:
  78
  79 ;;{{{ setup: libraries
  80
  81 (require 'tinylibm)
  82
  83 (eval-when-compile (ti::package-use-dynamic-compilation))
  84
  85 (eval-and-compile
  86   ;;  Forward declarations to quiet byte compiler.
  87   (defvar gnus-newsgroup-name)
  88   (defvar font-lock-mode)
  89   (defvar font-lock-keyword-face)
  90   (defvar global-font-lock-mode)
  91   (defvar font-lock-keywords)
  92   (defvar font-lock-defaults)
  93   (autoload 'gnus-summary-article-number  "gnus-sum")
  94   (autoload 'gnus-summary-display-article "gnus-sum")
  95   (defvar gnus-article-buffer))
  96
  97 (ti::package-defgroup-tiny TinyDebian tinydebian-: extensions
  98   "Debian System administrator's grabbag of utilities.")
  99
 100 ;;}}}
 101 ;;{{{ setup: hooks
 102
 103 ;;; ......................................................... &v-hooks ...
 104
 105 (defcustom tinydebian-:load-hook nil
 106   "*Hook run when file has been loaded."
 107   :type  'hook
 108   :group 'TinyDebian)
 109
 110 (defcustom tinydebian-:find-bug-nbr-hook '(tinydebian-bug-nbr-any)
 111   "*Functions to return Debian bug tracking number as string.
 112 Default value is '(tinydebian-bug-nbr-any)."
 113   :type  'function
 114   :group 'TinyDebian)
 115
 116 (defcustom tinydebian-:find-email-hook '(tinydebian-email-any)
 117   "*Functions to return Email address as string.
 118 Default value is '(tinydebian-email-any)."
 119   :type  'function
 120   :group 'TinyDebian)
 121
 122 (defcustom tinydebian-:load-hook nil
 123   "*Hook run when file has been loaded."
 124   :type  'hook
 125   :group 'TinyDebian)
 126
 127 (defcustom tinydebian-:browse-url-function
 128   (function tinydebian-browse-url-browse-url)
 129   "*Function to run for HTTP URLs. Default is `browse-url'.
 130 To use text mode buffer inside Emacs, set value to
 131 `tinydebian-browse-url-lynx-dump' if lynx(1) is available.
 132
 133 See also `browse-url-browser-function'."
 134   :type  'function
 135   :group 'TinyDebian)
 136
 137 ;;}}}
 138 ;;{{{ setup: user config
 139
 140 ;;; ................................................... &v-user-config ...
 141
 142 (defcustom tinydebian-:install-buffer-file-name-regexp
 143   "/debian/\\(changelog\\|.*README\\)"
 144   "*Activate `tinydebian-bts-mode' on buffers whose file name match regexp.
 145 This variable is used when function `tinydebian-install' is called."
 146   :type  'regexp
 147   :group 'TinyDebian)
 148
 149 (defcustom tinydebian-:buffer-tiger "*Tinydebian tiger*"
 150   "*Buffer name where to generate tiger(1) mail report chmod fixes.
 151 See function `tinydebian-command-audit-report-tiger'."
 152   :type  'string
 153   :group 'TinyDebian)
 154
 155 (defcustom tinydebian-:buffer-wnpp-alert "*Tinydebian wnpp-alert*"
 156   "*Buffer name where to generate wnpp-alert(1) report.
 157 See function `tinydebian-command-wnpp-alert'."
 158   :type  'string
 159   :group 'TinyDebian)
 160
 161 (defcustom tinydebian-:buffer-www "*Tinydebian WWW*"
 162   "*Buffer name where to put WWW call results.
 163 See `tinydebian-:browse-url-function'."
 164   :type  'string
 165   :group 'TinyDebian)
 166
 167 (defcustom tinydebian-:buffer-bug-format "*Tinydebian bug#%s*"
 168   "*A `format' string for buffer, where %s is substituted with bug number.
 169 See `tinydebian-buffer-url-bug'."
 170   :type  'string
 171   :group 'TinyDebian)
 172
 173 (defcustom tinydebian-:install-gnus-newsgroup-name-regexp
 174   "debian"
 175   "*Newsgroup name regexp to match to activate `tinydebian-bts-mode'."
 176   :type  'string
 177   :group 'TinyDebian)
 178
 179 (defface tinydebian-:warn-face
 180   '((((class color) (background light))
 181      (:background "green"))
 182     (((class color) (background dark))
 183      (:background "sea green"))
 184     (((class grayscale monochrome)
 185       (background light))
 186      (:background "black"))
 187     (((class grayscale monochrome)
 188       (background dark))
 189      (:background "white")))
 190   "Face used for warnings."
 191   :group 'TinyDebian)
 192
 193 ;;; Color loading section  This is messy *Blech!*
 194 ;;
 195 (defface tinydebian-:item-face
 196   '((((class color) (background light))
 197      (:foreground "green4"))
 198     (((class color) (background dark))
 199      (:foreground "green3")))
 200   "Face used for noticing important items."
 201   :group 'TinyDebian)
 202
 203 (defcustom tinydebian-:font-lock-mode t
 204   "If non-nil, allow turning on `font-lock-mode'.")
 205
 206 ;;}}}
 207 ;;{{{ setup: -- private
 208
 209 ;;; ....................................................... &v-private ...
 210
 211 (defvar tinydebian-:font-lock-keywords-adaptive-date t
 212   "Flag to signal that current time is used to display today's log.
 213 For exmple in /etc/syslog today's log log entries are highlighted
 214 differently that previous days. However this must be changed in
 215 next day, because the day changes.
 216
 217 This flags says, that adaptive-date regexps are be used.")
 218
 219 (make-variable-buffer-local 'tinydebian-:font-lock-keywords-adaptive-date)
 220
 221 (defvar tinydebian-:font-lock-keywords-bugs-rc ;; &font
 222   ;; Package: [59]bookmarks (optional; [60]Tobias Toedter) [bookmarks/1.4 ; =] [[61]
 223   ;; add/edit comment]
 224   ;; [62]401275 [P        N ] Remove two sites which force the user to enter a 24 mo
 225   ;; nth contract
 226   (list
 227    (list
 228     "Package: *\\[[0-9]+\\] *\\([a-z0-9.-]+\\)"
 229     1 'font-lock-builtin-face)
 230    (list
 231     (concat
 232      "^\\[[0-9]+\\][[0-9]+ *\\(\\[[^]\r\n]+\\]\\) +"
 233      "\\(.+"
 234      ;;  Continue to second line
 235      "\\(?:\n *[A-Za-z<>'()].*\\)?"
 236      "\\)")
 237     '(1 'font-lock-type-face)
 238     '(2 'font-lock-keyword-face)))
 239   "Font lock keywords to set after calling `tinydebian-url-list-bugs-by-rc'.
 240 Only used if `tinydebian-:browse-url-function'is set to
 241 `tinydebian-browse-url-lynx-dump'.")
 242
 243 (defvar tinydebian-:font-lock-package-bugs
 244   (list
 245    (list
 246     "Package: *\\[[0-9]+\\] *\\([a-z0-9.-]+\\)"
 247     1 'font-lock-builtin-face))
 248   "Font lock keywords to set after calling `tinydebian-url-list-bugs-by-rc'.
 249 Only used if `tinydebian-:browse-url-function'is set to
 250 `tinydebian-browse-url-lynx-dump'.")
 251
 252 (defconst tinydebian-:bin-dpkg (executable-find "dpkg")
 253   "Location of `dpkg' binary.")
 254
 255 (defconst tinydebian-:bin-grep-available (executable-find "grep-available")
 256   "Location of `grep-available' binary.")
 257
 258 (defvar tinydebian-:grep-find-devel-docdir-list
 259   '("/usr/share/doc/debian-policy"
 260     "/usr/share/doc/debian-reference-en"
 261     "/usr/share/doc/debian-reference-en"
 262     "/usr/share/doc/developers-reference")
 263   "*List of directororied to search for Debian development policy etc.")
 264
 265 (defvar tinydebian-:severity-list
 266   '(("critical"
 267      "Makes unrelated software on the system (or the whole system) break,
 268 or causes serious data loss, or introduces a security hole on systems where
 269 you install the package.")
 270     ("grave"
 271      "Makes the package in question unuseable or mostly so, or causes data
 272 loss, or introduces a security hole allowing access to the accounts of users
 273 who use the package.")
 274     ("serious"
 275      "Severe violation of Debian policy (that is, it violates a
 276 \"must\" or \"required\" directive), or, in the package maintainer's
 277 opinion, makes the package unsuitable for release.")
 278     ("important"
 279      "A bug which has a major effect on the usability of a package,
 280 without rendering it completely unusable to everyone.")
 281     ("normal"
 282      "The default value, applicable to most bugs.")
 283     ("minor"
 284      "A problem which doesn't affect the package's usefulness, and is
 285 presumably trivial to fix.")
 286     ("wishlist"
 287      "For any feature request, and also for any bugs that are very
 288 difficult to fix due to major design considerations.")
 289     ("fixed"
 290      "For bugs that are fixed but should not yet be closed. This is an
 291 exception for bugs fixed by non-maintainer uploads. Note: the "fixed"
 292 tag should be used instead."))
 293   "The bug system records a severity level with each bug report.
 294 This is set to normal by default, but can be overridden either by supplying a Severity line in the pseudo-header when the bug is submitted Severity or error.
 295 http://www.debian.org/Bugs/Developer#severities")
 296
 297 (defvar tinydebian-:severity-selected nil
 298   "Function `tinydebian-severity-select-*' sets this to user selection.")
 299
 300 (defconst tinydebian-:menu-severity
 301   '("\
 302 Severity: ?h)elp c)rit g)rave s)erious i)import RET-n)orm m)inor w)ish f)ixed"
 303     ;; NOTE: These function are automatically created, you don't find
 304     ;; then with C-s. See `tinydebian-install-severity-functions'
 305     ((?c .      ( (call-interactively 'tinydebian-severity-select-critical)))
 306      (?g .      ( (call-interactively 'tinydebian-severity-select-grave)))
 307      (?s .      ( (call-interactively 'tinydebian-severity-select-serious)))
 308      (?i .      ( (call-interactively 'tinydebian-severity-select-important)))
 309      (?n .      ( (call-interactively 'tinydebian-severity-select-normal)))
 310      (?\C-m .   ( (call-interactively 'tinydebian-severity-select-normal)))
 311      (?m .      ( (call-interactively 'tinydebian-severity-select-minor)))
 312      (?w .      ( (call-interactively 'tinydebian-severity-select-wishlist)))
 313      (?f .      ( (call-interactively 'tinydebian-severity-select-fixed)))))
 314   "Severity menu.
 315
 316 The bug system records a severity level with each bug report. This is set
 317 to normal by default, but can be overridden either by supplying a Severity
 318 line in the pseudo-header when the bug is submitted (see the instructions
 319 for reporting bugs), or by using the severity command with the control
 320 request server.
 321
 322 critical
 323     makes unrelated software on the system (or the whole system)
 324     break, or causes serious data loss, or introduces a security hole
 325     on systems where you install the package.
 326
 327 grave
 328     makes the package in question unuseable or mostly so, or causes
 329     data loss, or introduces a security hole allowing access to the
 330     accounts of users who use the package.
 331
 332 serious
 333     is a severe violation of Debian policy (that is, it violates a
 334     \"must\" or \"required\" directive), or, in the package
 335     maintainer's opinion, makes the package unsuitable for release.
 336
 337 important
 338     a bug which has a major effect on the usability of a package,
 339     without rendering it completely unusable to everyone.
 340
 341 normal
 342     the default value, applicable to most bugs.
 343
 344 minor
 345     a problem which doesn't affect the package's usefulness, and is
 346     presumably trivial to fix.
 347
 348 wishlist
 349     for any feature request, and also for any bugs that are very
 350     difficult to fix due to major design considerations.
 351
 352 fixed
 353     for bugs that are fixed but should not yet be closed. This is an
 354     exception for bugs fixed by non-maintainer uploads. Note: the
 355     \"fixed\" tag should be used instead. Certain severities are
 356     considered release-critical, meaning the bug will have an impact
 357     on releasing the package with the stable release of Debian.
 358     Currently, these are critical, grave and serious.")
 359
 360 (defvar tinydebian-:tags-list
 361   '(("already-in-ubuntu"
 362      "Package is in Ubuntu but not yet in Debian. This is a notice to a wishlist
 363 See <http://utnubu.alioth.debian.org/>.xm")
 364     ("patch"
 365      "A patch or some other easy procedure for fixing the bug is included
 366 in the bug logs. If there's a patch, but it doesn't resolve the bug
 367 adequately or causes some other problems, this tag should not be used.")
 368     ("wontfix"
 369      "This bug won't be fixed. Possibly because this is a choice between
 370 two arbitrary ways of doing things and the maintainer and submitter prefer
 371 different ways of doing things, possibly because changing the behaviour
 372 will cause other, worse, problems for others, or possibly for other reasons.")
 373     ("moreinfo"
 374      "This bug can't be addressed until more information is provided by
 375 the submitter. The bug will be closed if the submitter doesn't provide
 376 more information in a reasonable (few months) timeframe. This is for
 377 bugs like "It doesn't work". What doesn't work?.")
 378     ("unreproducible"
 379      "This bug can't be reproduced on the maintainer's system.
 380 Assistance from third parties is needed in diagnosing the cause of the problem.")
 381     ("help"
 382      "The maintainer is requesting help with dealing with this bug.")
 383     ("pending"
 384      "The problem described in the bug is being actively worked on,
 385 i.e. a solution is pending.")
 386     ("fixed"
 387      "This bug is fixed or worked around (by a non-maintainer upload,
 388 for example), but there's still an issue that needs to be resolved.
 389 This tag replaces the old \"fixed\" severity.")
 390     ("security"
 391      "This bug describes a security problem in a package (e.g., bad
 392 permissions allowing access to data that shouldn't be accessible;
 393 buffer overruns allowing people to control a system in ways they
 394 shouldn't be able to; denial of service attacks that should be fixed, etc).
 395 Most security bugs should also be set at critical or grave severity.")
 396     ("upstream"
 397      "This bug applies to the upstream part of the package.")
 398     ("confirmed"
 399      "The maintainer has looked at, understands, and basically agrees
 400 with the bug, but has yet to fix it. (Use of this tag is optional; it is
 401 intended mostly for maintainers who need to manage large numbers of open bugs.")
 402     ("fixed-upstream"
 403      "The bug has been fixed by the upstream maintainer, but not yet
 404 in the package (for whatever reason: perhaps it is too complicated to
 405 backport the change or too minor to be worth bothering).")
 406     ("ipv6"
 407      "This bug affects support for Internet Protocol version 6.")
 408     ("lfs"
 409      "This bug affects support for large files (over 2 gigabytes).")
 410     ("l10n"
 411      "This bug is relevant to the localisation of the package.")
 412     ("woody"
 413      "This bug particularly applies to the (unreleased) woody distribution.")
 414     ("sarge"
 415      "This bug particularly applies to the sarge distribution.")
 416     ("etch"
 417      "This bug particularly applies to the etch distribution.")
 418     ("sid"
 419      "This bug particularly applies to an architecture that is
 420 currently unreleased (that is, in the sid distribution).")
 421     ("experimental"
 422      "This bug particularly applies to the experimental distribution."))
 423   "Each bug can have zero or more of a set of given tags.
 424 These tags are displayed in the list of bugs when you look at a
 425 package's page, and when you look at the full bug log.
 426 See <http://www.debian.org/Bugs/Developer#tags>.")
 427
 428 (defvar tinydebian-:wnpp-buffer "*TinyDebian WNPP*"
 429   "WNPP question buffer.")
 430
 431 (defvar tinydebian-:menu-wnpp-selected nil
 432   "Placeholder of selection from `tinydebian-:menu-wnpp'.")
 433
 434 (defconst tinydebian-:menu-wnpp
 435   (list
 436    '(format
 437      "TinyDebian:WNPP%s 1i)tp 2o)rphan 3a)dopt 4n)ew package ?)help q)uit"
 438      (if tinydebian-:menu-wnpp-selected
 439          (format ";%s " (symbol-name tinydebian-:menu-wnpp-selected))
 440        ""))
 441    (list
 442     '(?1 . ( (setq tinydebian-:menu-wnpp-selected 'package)))
 443     '(?i . ( (setq tinydebian-:menu-wnpp-selected 'package)))
 444     '(?I . ( (setq tinydebian-:menu-wnpp-selected 'package)))
 445     '(?p . ( (setq tinydebian-:menu-wnpp-selected 'package)))
 446     '(?P . ( (setq tinydebian-:menu-wnpp-selected 'package)))
 447     '(?2 . ( (setq tinydebian-:menu-wnpp-selected 'oprhan)))
 448     '(?o . ( (setq tinydebian-:menu-wnpp-selected 'oprhan)))
 449     '(?O . ( (setq tinydebian-:menu-wnpp-selected 'oprhan)))
 450     '(?3 . ( (setq tinydebian-:menu-wnpp-selected 'adopt)))
 451     '(?a . ( (setq tinydebian-:menu-wnpp-selected 'adopt)))
 452     '(?A . ( (setq tinydebian-:menu-wnpp-selected 'adopt)))
 453     '(?4 . ( (setq tinydebian-:menu-wnpp-selected 'new)))
 454     '(?n . ( (setq tinydebian-:menu-wnpp-selected 'new)))
 455     '(?N . ( (setq tinydebian-:menu-wnpp-selected 'new)))))
 456   ;;  This message is straight from reportbug(1)
 457   ;;  'apt-get install reportbug'
 458   "What request type? If none of these things mean anything to you, or
 459 you are trying to report a bug in an existing package)
 460
 461 1 p    ITP, `Intent To Package'. Please submit a package description
 462        along with copyright and URL in such a report.
 463
 464 2 o    The package has been `Orphaned'. It needs a new maintainer as soon as
 465        possible.
 466
 467 3 a    RFA, this is a `Request for Adoption'. Due to lack of time, resources,
 468        interest or something similar, the current maintainer is asking for
 469        someone else to maintain this package. He/she will maintain it in the
 470        meantime, but perhaps not in the best possible way. In short: the
 471        package needs a new maintainer.
 472
 473 4 n    RFP, this is a `Request For Package'. You have found an interesting piece of
 474        software and would like someone else to maintain it for Debian. Please
 475        submit a package description along with copyright and URL in such a
 476        report.
 477
 478 q      Quit menu.
 479 ")
 480
 481 (defconst tinydebian-:rfp-template "\
 482 Package: wnpp
 483 Severity: wishlist
 484
 485 * Package name    : <package>
 486   Version         : x.y.z
 487   Upstream Author : Name <somebody@example.org>
 488 * URL             : <homepage: http://www.example.org/>
 489 * License         : <license: GPL, LGPL, BSD, MIT/X, etc.>
 490   Programming Lang: <C, C++, C#, Perl, Python, etc.>
 491   Description     : <short desc>
 492
 493 \(Include the long description here.)
 494 "
 495   "Wnpp RFP/ITP template.
 496 NOTE: The <TAG:> constructs must be retained.")
 497
 498 (defvar tinydebian-:rfp-hook nil
 499   "Hook run after function `tinydebian-bts-mail-type-rfp'.
 500 See also `tinydebian-:rfp-template'")
 501
 502 (defconst tinydebian-:wnpp-template-licenses-alist
 503   '("Artistic"
 504     "BSD"
 505     "GPL"
 506     "GPL-2"
 507     "LGPL"
 508     "LGPL-2"
 509     "MIT/X11")
 510   "List of licenses as recorded in Debian /usr/share/common-licenses/
 511 See also <http://www.debian.org/legal/licenses/> and
 512 <http://people.debian.org/~bap/dfsg-faq.html>.")
 513
 514 (defconst tinydebian-:rfs-template "\
 515
 516 I'm looking for sponsor:
 517
 518   Package name    : <package>
 519   Version         : x.y.z
 520   ITA/ITP URL     : <ita: http://bugs.debian.org/BugNbr>
 521 * Package bugs URL: <bugs: http://bugs.debian.org/Package>
 522   URL             : <mentors: http://mentors.debian.net/debian/pool/main/p/package/*.dsc>
 523   License         : <license: GPL, LGPL, BSD, MIT/X, Artistic, etc.>
 524   Programming Lang: <C, C++, C#, Perl, Python, etc.>
 525
 526 \(* = remove if package is not in Debian.)
 527 Description:
 528
 529 debian/changelog:
 530
 531 Other notes:
 532 "
 533   "RFS message to debian.devel.mentor mailinf list.
 534 NOTE: The <TAG:> constructs must be retained.
 535 See also `tinydebian-:rfs-hook'.")
 536
 537 (defvar tinydebian-:rfs-hook nil
 538   "Hook run after function `tinydebian-bts-mail-type-rfs'.
 539 See also `tinydebian-:rfs-template'")
 540
 541 (defvar tinydebian-:bts-email-address "bugs.debian.org"
 542   "Email address or Debian Bug Tracking System.")
 543
 544 ;; https://help.launchpad.net/UsingMaloneEmail
 545 (defvar tinydebian-:launchpad-email-address "bugs.launchpad.net"
 546   "Email address or Debian Bug Tracking System.")
 547
 548 (defvar tinydebian-:list-email-address "lists.debian.org"
 549   "Email address or Debian mailing lists.")
 550
 551 (defvar tinydebian-:url-http-package-search
 552   ;; http://packages.debian.net/search?keywords=chbg&searchon=names
 553   "http://packages.debian.net/search?"
 554   "The packages Debian control URL without parameter, up to '?' token.")
 555
 556 (defconst tinydebian-:url-http-package-bugs
 557   "http://bugs.debian.org"
 558   "The bugs Debian control URL without parameter, up to '/' token.")
 559
 560 (defvar tinydebian-:url-http-debian-www
 561   "http://www.debian.org"
 562   "The main WWW page of Debian.")
 563
 564 (defvar tinydebian-:url-http-wnpp-page-main
 565   "http://www.debian.org/devel/wnpp"
 566   "The WNPP main page URL address. No trailing slash.")
 567
 568 (defconst tinydebian-:url-http-wnpp-page-alist
 569   '(("RFA" . "rfa_bypackage")
 570     ("O"   . "orphaned")
 571     ("RFH" . "help_request")
 572     ("RFP" . "requested")
 573     ("ITP" . "being_packaged"))
 574   "List of mapping to pages under `tinydebian-:url-http-wnpp-page-main'.")
 575
 576 (defconst tinydebian-:url-debian-page-alist
 577   (list
 578    '(bts-control
 579      "http://www.debian.org/Bugs/server-control")
 580    ;; 2006-11-06 unofficial
 581    (list 'bugs-rc
 582          "http://bts.turmzimmer.net/details.php"
 583          tinydebian-:font-lock-keywords-bugs-rc)
 584    '(qa-developer-status
 585      "http://qa.debian.org/developer.php?")
 586    '(qa-developer-bugs
 587      "http://bugs.debian.org/cgi-bin/pkgreport.cgi?")
 588    '(dfsg-license-faq
 589      "http://people.debian.org/~bap/dfsg-faq.html")
 590    '(base-files-faq
 591      "http://ftp.debian.org/doc/base-files/FAQ")
 592    '(debcheck-package
 593      "http://qa.debian.org/debcheck.php?dist=%s&package=%s")
 594    '(mentors
 595      "http://mentors.debian.net")
 596    '(mentors-pkg-pool
 597      "http://mentors.debian.net/debian/pool")
 598    '(pkg-search-files
 599      "http://packages.debian.org/cgi-bin/search_contents.pl?searchmode=searchfiles&case=insensitive")
 600    '(developers-reference
 601      "http://www.debian.org/doc/packaging-manuals/developers-reference/")
 602    ;;  apt-get install debian-reference-common debian-reference-en
 603    '(developers-reference-text
 604      "/usr/share/doc/Debian/reference/reference.en.txt.gz")
 605    '(policy
 606      "http://www.debian.org/doc/debian-policy/index.html")
 607    '(policy-text
 608      "/usr/share/doc/debian-policy/policy.txt.gz")
 609    '(newmaint-guide
 610      "http://www.debian.org/doc/maint-guide/")
 611    '(best-practises
 612      "http://www.debian.org/doc/packaging-manuals/developers-reference/ch-best-pkging-practices.en.html"))
 613   "List of Debian site pages.
 614 Format:
 615  '((PAGE-TYPE  URL [FONT-LOCK-KEYWORDS])
 616    ...)
 617
 618 The FONT-LOCK-KEYWORDS is only used if the results appear in `tinydebian-:buffer-www'.
 619 See `tinydebian-:browse-url-function'.")
 620
 621 ;;}}}
 622 ;;{{{ setup: -- version
 623
 624 ;;; ....................................................... &v-version ...
 625
 626 ;;;###autoload (autoload 'tinydebian-version "tinydebian" "Display commentary." t)
 627 (eval-and-compile
 628   (ti::macrof-version-bug-report
 629    "tinydebian.el"
 630    "tinydebian"
 631    tinydebian-:version-id
 632    "$Id: tinydebian.el,v 1.97 2007/08/04 10:09:46 jaalto Exp $"
 633    '(tinydebian-version-id
 634      tinydebian-:load-hook
 635      tinydebian-:font-lock-keywords-adaptive-date
 636      tinydebian-:bin-dpkg
 637      tinydebian-:severity-list
 638      tinydebian-:severity-selected
 639      tinydebian-:tags-list)))
 640
 641 (defvar tinydebian-:bts-extra-headers
 642   (format "X-Bug-User-Agent: Emacs %s and tinydebian.el %s\n"
 643           emacs-version
 644           (substring tinydebian-:version-id 21 25))
 645   "Header to add to BTS control mails.")
 646
 647 ;;}}}
 648 ;;{{{ Install: bindings
 649
 650 ;;; ........................................................ &bindings ...
 651
 652 ;; #todo:
 653 (defun tinydebian-default-bindings ()
 654   "Define default key bindings to `tinydebian-mode-map'.")
 655
 656 (eval-and-compile
 657
 658 ;;;###autoload (autoload 'tinydebian-bts-mode          "tinydebian" "" t)
 659 ;;;###autoload (autoload 'turn-on-tinydebian-bts-mode  "tinydebian" "" t)
 660 ;;;###autoload (autoload 'turn-off-tinydebian-bts-mode "tinydebian" "" t)
 661 ;;;###autoload (defvar tinydebian-:bts-mode-prefix-key "\C-c-")
 662   (ti::macrof-minor-mode-wizard
 663    "tinydebian-bts-" " Tdeb" "\C-c-" "Tdeb" 'TinyDebian "tinydebian-:bts-" ;1-6
 664
 665    "Debian Bug Tracking System (BTS) Minor mode. With this mode you can
 666 jump to a bug report at or near current point (using browser), send
 667 control messages, like turning RFS into ITP, send new RFS, send new
 668 ITP etc.
 669
 670 Prefix key is:
 671
 672   tinydebian-:bts-mode-prefix-key
 673
 674 Mode description:
 675
 676 \\{tinydebian-:bts-mode-prefix-map}"
 677
 678    "TinyDebian BTS"
 679    nil
 680    "TinyDebian BTS minor mode menu."
 681    (list
 682     tinydebian-:bts-mode-easymenu-name
 683     ["Reply to bug"                  tinydebian-bts-mail-type-reply            t]
 684     ["Report bug by mail"            tinydebian-bug-report-mail                t]
 685     ["Goto URL by bug number"        tinydebian-bug-browse-url-by-bug          t]
 686     ["Goto URL by package bugs"      tinydebian-bug-browse-url-by-package-bugs t]
 687     ["Goto URL by package name"      tinydebian-bug-browse-url-by-package-name t]
 688
 689     "----"
 690
 691     (list
 692      "BTS WNPP messages"
 693      ["Send BTS ITA: intent to adopt"      tinydebian-bts-mail-type-ita    t]
 694      ["Send BTS ITP: reponse to RFP"       tinydebian-bts-mail-type-itp    t]
 695      ["Send BTS RFA: request for adopt"    tinydebian-bts-mail-type-rfa    t]
 696      ["Send BTS RFH: request for help"     tinydebian-bts-mail-type-rfh    t]
 697      ["Send BTS RFP: request for packege"  tinydebian-bts-mail-type-rfp    t]
 698      ["Send BTS RFS: request for sponsor"  tinydebian-bts-mail-type-rfs    t]
 699      ["Send BTS O: orphan"                 tinydebian-bts-mail-type-orphan t]
 700      ["WNPP control menu"                  tinydebian-package-wnpp-main    t])
 701
 702     (list
 703      "BTS Control messages"
 704      ["Send BTS Ctrl close"                tinydebian-bts-mail-ctrl-close    t]
 705      ["Send BTS Ctrl severity"             tinydebian-bts-mail-ctrl-severity t]
 706      ["Send BTS Ctrl tags"                 tinydebian-bts-mail-ctrl-tags     t]
 707      ["Send BTS Ctrl usertag"              tinydebian-bts-mail-ctrl-usertag  t]
 708      ["Send BTS Ctrl forward"              tinydebian-bts-mail-ctrl-forward-main  t]
 709      ["Send BTS Ctrl reassign"             tinydebian-bts-mail-ctrl-reassign t]
 710      ["Send BTS Ctrl retitle"              tinydebian-bts-mail-ctrl-retitle  t]
 711      ["Send BTS Ctrl reopen"               tinydebian-bts-mail-ctrl-reopen   t])
 712
 713     (list
 714      "Query information"
 715      ["List of WNPP RFP"           tinydebian-url-list-wnpp-rfp            t]
 716      ["List of WNPP RFH"           tinydebian-url-list-wnpp-rfh            t]
 717      ["List of WNPP RFA"           tinydebian-url-list-wnpp-rfa            t]
 718      ["List of WNPP Orphaned"      tinydebian-url-list-wnpp-orphaned       t]
 719      ["List of WNPP ITP"           tinydebian-url-list-wnpp-itp            t]
 720      ["List of RC bugs"            tinydebian-url-list-bugs-by-rc          t]
 721      ["List of items by usertag"   tinydebian-url-list-bugs-by-usertag     t]
 722      ["Installed pkg problems"     tinydebian-command-show-wnpp-alert      t]
 723      ["Grep devel documentation"   tinydebian-grep-find-debian-devel       t]
 724
 725      "----"
 726
 727      ["QA Developer status"        tinydebian-url-list-qa-developer-status t]
 728      ["QA Developer bugs"          tinydebian-url-list-qa-developer-bugs   t]
 729      ["Package debcheck"           tinydebian-url-list-package-debcheck    t]
 730      ["Package search by name"     tinydebian-url-list-package-by-package-name t]
 731      ["Package search by filename" tinydebian-url-list-package-by-filename t]
 732
 733      "----"
 734
 735      ["FAQ DFSG and licenses"      tinydebian-url-list-dsfg-license-faq    t]
 736      ["FAQ base files"             tinydebian-url-list-base-files-faq      t])
 737
 738     (list
 739      "Debian manuals"
 740      ["URL BTS Ctrl page"            tinydebian-url-bts-ctrl-page         t]
 741      ["URL Policy manual"            tinydebian-url-policy-manual         t]
 742      ["URL Newmaint guide"           tinydebian-url-policy-new-maintainer-guide  t]
 743      ["URL Developer's reference"    tinydebian-url-policy-developers-reference  t]
 744      ["URL Best practises"           tinydebian-url-policy-best-practises t]))
 745
 746    (progn
 747
 748      (define-key map  "b"  'tinydebian-bug-browse-url-by-bug)
 749      (define-key map  "B"  'tinydebian-bug-browse-url-by-package-bugs)
 750      (define-key map  "M"  'tinydebian-bug-report-mail)
 751      (define-key map  "p"  'tinydebian-bug-browse-url-by-package-name)
 752      (define-key map  "r"  'tinydebian-bug-reply)
 753      (define-key map  "w"  'tinydebian-package-wnpp-main)
 754
 755      (define-key map  "-a" 'tinydebian-bts-mail-type-ita)
 756      (define-key map  "-A" 'tinydebian-bts-mail-type-rfa)
 757      (define-key map  "-h" 'tinydebian-bts-mail-type-rfh)
 758      (define-key map  "-P" 'tinydebian-bts-mail-type-itp)
 759      (define-key map  "-p" 'tinydebian-bts-mail-type-rfp)
 760      (define-key map  "-r" 'tinydebian-bts-mail-type-reply)
 761      (define-key map  "-s" 'tinydebian-bts-mail-type-rfs)
 762      (define-key map  "-o" 'tinydebian-bts-mail-type-orphan)
 763      (define-key map  "mi" 'tinydebian-bts-mail-message-info)
 764
 765      ;;  (i)nfo (i)nstalled
 766      (define-key map  "ii" 'tinydebian-command-show-wnpp-alert)
 767
 768      ;;  (i)nfo (g)rep
 769      (define-key map  "ig" 'tinydebian-grep-find-debian-devel)
 770
 771      ;;  (L)ist Url commands
 772      ;; (b)ugs
 773      (define-key map  "lbr"  'tinydebian-url-list-bugs-by-rc)
 774      (define-key map  "lbu"  'tinydebian-url-list-bugs-by-usertag)
 775      ;; (d)eveloper
 776      (define-key map  "ldb"  'tinydebian-url-list-qa-developer-bugs)
 777      (define-key map  "lds"  'tinydebian-url-list-qa-developer-status)
 778      ;; (f)aq
 779      (define-key map  "lfl"  'tinydebian-url-list-dsfg-license-faq)
 780      (define-key map  "lfb"  'tinydebian-url-list-base-files-faq)
 781      ;; (p)ackage
 782      (define-key map  "lpf"  'tinydebian-url-list-package-by-filename)
 783      (define-key map  "lpp"  'tinydebian-url-list-package-by-package-name)
 784      (define-key map  "lpc"  'tinydebian-url-list-package-debcheck)
 785      ;; (w)npp
 786      (define-key map  "lwa"  'tinydebian-url-list-wnpp-rfa)
 787      (define-key map  "lwh"  'tinydebian-url-list-wnpp-rfh)
 788      (define-key map  "lwo"  'tinydebian-url-list-wnpp-orphaned)
 789      (define-key map  "lwp"  'tinydebian-url-list-wnpp-rfp)
 790      (define-key map  "lwP"  'tinydebian-url-list-wnpp-itp)
 791
 792      ;;  (C)ontrol commands
 793      (define-key map  "cc"  'tinydebian-bts-mail-ctrl-close)
 794      (define-key map  "cs"  'tinydebian-bts-mail-ctrl-severity)
 795      (define-key map  "ct"  'tinydebian-bts-mail-ctrl-tags)
 796      (define-key map  "cT"  'tinydebian-bts-mail-ctrl-usertag)
 797      (define-key map  "cf"  'tinydebian-bts-mail-ctrl-forward-main)
 798      (define-key map  "cr"  'tinydebian-bts-mail-ctrl-reassign)
 799      (define-key map  "cR"  'tinydebian-bts-mail-ctrl-retitle)
 800      (define-key map  "co"  'tinydebian-bts-mail-ctrl-reopen)
 801
 802      ;;  URLs
 803      (define-key map  "ub"  'tinydebian-url-bts-ctrl-page)
 804      (define-key map  "ud"  'tinydebian-url-policy-developers-reference)
 805      (define-key map  "un"  'tinydebian-url-policy-new-maintainer-guide)
 806      (define-key map  "up"  'tinydebian-url-policy-manual)
 807      (define-key map  "uP"  'tinydebian-url-policy-best-practises))))
 808
 809 ;;; ----------------------------------------------------------------------
 810 ;;;
 811 (defun tinydebian-bts-mode-gnus-summary-maybe-turn-on ()
 812   "Activate tinydebian-bts-mode if group name contains word 'Debian'"
 813   (when (and (boundp 'gnus-newsgroup-name)
 814              (stringp gnus-newsgroup-name)
 815              (string-match "debian" gnus-newsgroup-name))
 816     (turn-on-tinydebian-bts-mode)))
 817
 818 ;;; ----------------------------------------------------------------------
 819 ;;;
 820 (defun tinydebian-bts-mode-maybe-turn-on ()
 821   "Activate tinydebian-bts-mode if buffer contains word 'Debian'"
 822   (when (save-excursion
 823           (goto-char (point-min))
 824           (re-search-forward "debian" nil t))
 825     (turn-on-tinydebian-bts-mode)))
 826
 827 ;;}}}
 828 ;;{{{ Install: generate severity function etc.
 829
 830 ;;; ----------------------------------------------------------------------
 831 ;;;
 832 (defun tinydebian-install-severity-functions ()
 833   "Generate `tinydebian-severity-select-*' user functions."
 834   ;; Generate functions on run-time.
 835   (mapcar
 836    (function
 837     (lambda (x)
 838       (let ((sym (intern (format "tinydebian-severity-select-%s"  x)))
 839             def)
 840         (setq def
 841               (` (defun (, sym) ()
 842                    "Set Severity level `tinydebian-:severity-selected'."
 843                    (interactive)
 844                    (setq  tinydebian-:severity-selected (, x)))))
 845         (eval def))))
 846    '("critical"
 847      "grave"
 848      "serious"
 849      "important"
 850      "normal"
 851      "minor"
 852      "wishlist"
 853      "fixed")))
 854
 855 ;;; ----------------------------------------------------------------------
 856 ;;;
 857 (defun tinydebian-find-file-hooks ()
 858   "Run `tinydebian-bts-mode-maybe-turn-on'.
 859 Install `font-lock-keywords' for log files."
 860   (tinydebian-bts-mode-maybe-turn-on)
 861   (tinydebian-font-lock-keywords))
 862
 863 ;;; ----------------------------------------------------------------------
 864 ;;;
 865 (defun tinydebian-install-font-lock-keywords (&optional uninstall)
 866   "Install colors to all current buffers."
 867   (dolist (buffer (buffer-list))
 868     (with-current-buffer buffer
 869       (tinydebian-font-lock-keywords uninstall))))
 870
 871 ;;; ----------------------------------------------------------------------
 872 ;;;
 873 ;;;###autoload
 874 (defun tinydebian-install-in-buffers (&optional uninstall)
 875   "Install or UNINSTALL `tinydebiab-bts-mode' in existing buffers.
 876 Activate on Gnus summary and article modes if there is word 'Debian'.
 877 Activate on files whose path matches
 878 `tinydebian-:install-buffer-file-name-regexp'."
 879   (flet ((search (regexp)
 880                  (save-excursion
 881                    (goto-char (point-min))
 882                    (re-search-forward regexp nil t))))
 883     (dolist (buffer (buffer-list))
 884       (let (doit)
 885         (with-current-buffer buffer
 886           (cond
 887            ((and (stringp buffer-file-name)
 888                  (string-match tinydebian-:install-buffer-file-name-regexp
 889                                buffer-file-name))
 890             (setq doit t))
 891            ((and (eq major-mode 'gnus-summary-mode)
 892                  (boundp 'gnus-newsgroup-name)
 893                  (string-match
 894                   tinydebian-:install-gnus-newsgroup-name-regexp
 895                   gnus-newsgroup-name))
 896             (setq doit t))
 897            ((and (eq major-mode 'gnus-article-mode)
 898                  (search "debian"))
 899             (setq doit t))
 900            ((search (concat
 901                      "bug#[0-9][0-9][0-9][0-9][0-9][0-9]\\>"
 902                      "\\|Closes +#[0-9][0-9][0-9][0-9][0-9][0-9]"))
 903             (setq doit t)))
 904           (if uninstall
 905               (turn-off-tinydebian-bts-mode)
 906             (turn-on-tinydebian-bts-mode)))))))
 907
 908 ;;; ----------------------------------------------------------------------
 909 ;;;
 910 (defun tinydebian-install (&optional uninstall)
 911   "Install or UNINSTALL package."
 912   (interactive "P")
 913   ;;  This just hides from byte compiler function definition
 914   ;;  so that it does not remember how amny arguments it takes
 915   ;;
 916   ;;  function tinydebian-bug-report-mail used to take 0+ arguments,
 917   ;;  now takes 1 function tinydebian-bug-report-mail defined multiple
 918   ;;  times in this file
 919   ;;
 920   (cond
 921    (uninstall
 922     ;;(remove-hook 'write-file-hooks 'tinydebian-auto-save)
 923     (tinydebian-install-font-lock-keywords 'uninstall)
 924     (remove-hook 'find-file-hooks 'tinydebian-find-file-hooks)
 925     (remove-hook 'gnus-summary-prepare-hook
 926                  'tinydebian-bts-mode-gnus-summary-maybe-turn-on)
 927     (remove-hook 'gnus-article-prepare-hook
 928                  'tinydebian-bts-mode-maybe-turn-on)
 929     (tinydebian-install-in-buffers 'uninstall))
 930    (t
 931     ;; (add-hook 'write-file-hooks 'tinydebian-auto-save)
 932     (tinydebian-install-font-lock-keywords)
 933     (add-hook 'find-file-hooks  'tinydebian-find-file-hooks)
 934     (add-hook 'gnus-summary-prepare-hook
 935               'tinydebian-bts-mode-gnus-summary-maybe-turn-on)
 936     (add-hook 'gnus-article-prepare-hook
 937               'tinydebian-bts-mode-maybe-turn-on)
 938     (tinydebian-install-in-buffers)))
 939   nil)
 940
 941 ;;}}}
 942 ;;{{{ Utility functions
 943
 944 ;;; ----------------------------------------------------------------------
 945 ;;;
 946 (defmacro tinydebian-launchpad-email-compose (address)
 947   "Send message to Launchpad at ADDRESS."
 948   `(format "%s@%s" ,address tinydebian-:launchpad-email-address))
 949
 950 ;;; ----------------------------------------------------------------------
 951 ;;;
 952 (defsubst tinydebian-launchpad-email-new ()
 953   (tinydebian-launchpad-email-compose "new"))
 954
 955 ;;; ----------------------------------------------------------------------
 956 ;;;
 957 (defmacro tinydebian-list-email-compose (address)
 958   "Send message to Debian mailing list at ADDRESS."
 959   `(format "%s@%s" ,address tinydebian-:list-email-address))
 960
 961 ;;; ----------------------------------------------------------------------
 962 ;;;
 963 (defmacro tinydebian-bts-email-compose (address)
 964   "Send message to Debian BTS at ADDRESS."
 965   `(format "%s@%s" ,address tinydebian-:bts-email-address))
 966
 967 ;;; ----------------------------------------------------------------------
 968 ;;;
 969 (defsubst tinydebian-bts-email-submit ()
 970   (tinydebian-bts-email-compose "submit"))
 971
 972 ;;; ----------------------------------------------------------------------
 973 ;;;
 974 (defsubst tinydebian-bts-email-control ()
 975   (tinydebian-bts-email-compose "control"))
 976
 977 ;;; ----------------------------------------------------------------------
 978 ;;;
 979 (defmacro tinydebian-package-narrow-to-region (&rest body)
 980   "Search dpkg -s result from current point forward and narrow around it.
 981 Point is put at the beginning of region.
 982 Variable `package' contains the package name."
 983   (`
 984    (let* (beg-narrow
 985           package)
 986      (when (re-search-forward "^Package: +\\([^ \t\r\n]+\\) *$" nil t)
 987        (setq beg-narrow (line-beginning-position))
 988        (setq package (match-string 1))
 989        (when (re-search-forward "^[ \t]*$" nil t)
 990          (ti::narrow-safe beg-narrow (point)
 991            (ti::pmin)
 992            (,@ body)))))))
 993
 994 ;;; ----------------------------------------------------------------------
 995 ;;;
 996 (put 'tinydebian-with-buffer-macro 'edebug-form-spec '(body))
 997 (put 'tinydebian-with-buffer-macro 'lisp-indent-function 0)
 998 (defmacro tinydebian-with-buffer-macro (buffer &rest body)
 999   "Create BUFFER, empty it and run BODY.
1000 Variable `buffer' is available in this macro."
1001   `(let ((buffer (get-buffer-create ,buffer)))
1002      (with-current-buffer buffer
1003        (erase-buffer)
1004        ,@body)))
1005
1006 ;;; ----------------------------------------------------------------------
1007 ;;;
1008 (defsubst tinydebian-string-p (str &optional error)
1009   "Check that STR contains non-empty value.
1010 Signal optional ERROR message is STR was empty."
1011   (or (and (stringp str)
1012            (string-match "[^ \t\r\n]" str))
1013       (and (stringp error)
1014            (error "TinyDebian: %s" error))))
1015
1016 ;;; ----------------------------------------------------------------------
1017 ;;;
1018 (defsubst tinydebian-buffer-match-string (regexp &optional start)
1019   "Search REGEX at optional START point and return submatch 1."
1020   (save-excursion
1021     (if start
1022         (goto-char start))
1023     (if (re-search-forward regexp nil t)
1024         (match-string 1))))
1025
1026 ;;; ----------------------------------------------------------------------
1027 ;;;
1028 (defsubst tinydebian-call-process (prg &optional buffer &rest args)
1029   "Call PRG with list of ARGS and print output to current buffer or BUFFER."
1030   (apply 'call-process
1031          prg
1032          (not 'infile)
1033          (or buffer (current-buffer))
1034          (not 'real-time-display)
1035          args))
1036
1037 ;;; ----------------------------------------------------------------------
1038 ;;;
1039 (defsubst tinydebian-packages-browse-url-compose
1040   (keyword &optional search-on distribution section)
1041   "Return URL search string.
1042 Argument: KEYWORD
1043 Optional: SEARCH-ON DISTRIBUTION SECTION."
1044   (format (concat tinydebian-:url-http-package-search
1045                   "keywords=%s&"
1046                   "searchon=%s&"
1047                   "subword=1&"
1048                   "version=%s&"
1049                   "release=%s")
1050           keyword
1051           (or search-on    "names")
1052           (or distribution "all")
1053           (or section      "all")))
1054
1055 ;;; ----------------------------------------------------------------------
1056 ;;;
1057 (defsubst tinydebian-string-delete-newlines (string)
1058   "Delete newlines from STRING."
1059   (ti::string-regexp-delete "[\r\n]" string))
1060
1061 ;;; ----------------------------------------------------------------------
1062 ;;;
1063 (defsubst tinydebian-read-license (message)
1064   "Ask license with MESSAGE.
1065   See `tinydebian-:wnpp-template-licenses-alist'."
1066   (completing-read
1067    message
1068    (mapcar (lambda (x)
1069              (cons x 1))
1070            tinydebian-:wnpp-template-licenses-alist)))
1071
1072 ;;; ----------------------------------------------------------------------
1073 ;;;
1074 (defun tinydebian-font-lock-keywords (&optional uninstall)
1075   "Add color support to various log files by setting
1076 `font-lock-keywords'."
1077   (interactive)
1078   (let* ((today  (ti::date-standard-rfc-regexp "mon-date"))
1079          ;; (cs     (or comment-start-skip "[ \t]+"))
1080          (file   "")
1081          keywords)
1082     (when (stringp buffer-file-name)
1083       (setq file (or buffer-file-name "no-name?")))
1084     (setq
1085      keywords
1086      (cond
1087       ;; ............................................. Linux log files ...
1088       ;; /var/log/
1089       ((string-match "/log/messages$" file)
1090        ;; font-lock-constant-face
1091        (make-local-variable 'font-lock-defaults)
1092        (setq font-lock-keywords
1093              (list
1094               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1095                     0 'font-lock-function-name-face)
1096               (list
1097                (concat
1098                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1099                0 'font-lock-reference-face)
1100               (list
1101                (concat "restarted\\|started"
1102                        "\\|ignoring"
1103                        "\\|Linux version.*")
1104                0 'font-lock-comment-face))))
1105
1106       ((string-match "mail\\.log\\|mail\\.info" file)
1107        ;; font-lock-constant-face
1108        (make-local-variable 'font-lock-defaults)
1109        (setq font-lock-keywords
1110              (list
1111               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1112                     0 'font-lock-function-name-face)
1113               (list
1114                (concat
1115                 "^... +[0-9]+ ++[0-9]+:+[0-9]+:+[0-9]+")
1116                0 'font-lock-reference-face)
1117               '("timed out\\|did not.*"
1118                 0 tinydebian-:warn-face)
1119               (list
1120                (concat "\\(from\\|to\\)=\\([^ ,\t\r\n]+\\)")
1121                2 'font-lock-comment-face))))
1122
1123       ((string-match "daemon\\.log" file)
1124        ;; font-lock-constant-face
1125        (make-local-variable 'font-lock-defaults)
1126        (setq font-lock-keywords
1127              (list
1128               (list
1129                (concat
1130                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1131                0 'font-lock-reference-face)
1132               (list
1133                (concat "connection attempt" ;);  See "iplogger" package
1134                        0 'tinydebian-:warn-face)
1135                (list
1136                 (concat "signal +[0-9]+\\|no such user"
1137                         "\\|connect from .*")
1138                 0 'font-lock-comment-face)))))
1139
1140       ((string-match "auth\\.log" file)
1141        ;; font-lock-constant-face
1142        (make-local-variable 'font-lock-defaults)
1143        (setq font-lock-keywords
1144              (list
1145               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1146                     0 'font-lock-function-name-face)
1147               (list
1148                (concat
1149                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1150                0 'font-lock-reference-face)
1151               (list
1152                (concat "opened +for +[^ \t\r\n]+")
1153                0 'tinydebian-:warn-face)
1154               '( "for user \\(root\\)"
1155                  1 font-lock-string-face)
1156               '( "from \\([^ \t\r\n]+\\)"
1157                  1 font-lock-type-face)
1158               '( "for +\\([^ \t\r\n]+\\) +from"
1159                  1 font-lock-comment-face)
1160               '( "for user +\\([^ \t\r\n]+\\)"
1161                  1 font-lock-comment-face))))
1162
1163       ((string-match "syslog" file)
1164        ;; font-lock-constant-face
1165        (make-local-variable 'font-lock-defaults)
1166        (setq font-lock-keywords
1167              (list
1168               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1169                     0 'font-lock-function-name-face)
1170               (list
1171                (concat
1172                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1173                0 'font-lock-reference-face)
1174               (list
1175                (concat "Invalid.*"
1176                        ;; portmap[135]: cannot bind udp: Address already in use
1177                        "\\|cannot"
1178                        "\\|Connection timed out"
1179                        ;;  See iplogger(1)
1180                        "\\|connection attempt"
1181                        ;;  See portsentry(1)
1182                        "\\|attackalert:.* +to +.*port.*"
1183                        ;;  apm -s failed
1184                        "\\| failed"
1185                        "\\|did not .*")
1186                0 'tinydebian-:warn-face)
1187               '("to=\\([^ \t\r\n]+\\)"
1188                 1 font-lock-comment-face)
1189               '("(\\([^ )\t\r\n]+\\)) CMD "
1190                 1 font-lock-comment-face)
1191               '("CMD .*"
1192                 0 font-lock-constant-face)
1193               '("inetd"2
1194                 0 font-lock-type-face)
1195               (list
1196                (concat
1197                 "program exit.*\\|.*started.*"
1198                 ;;  btpd daemon
1199                 "\\|synchronisation lost")
1200                0 font-lock-keyword-face))))))
1201     (when keywords
1202       (cond
1203        (uninstall
1204         (setq font-lock-keywords nil))
1205        ((or font-lock-mode
1206             tinydebian-:font-lock-mode
1207             global-font-lock-mode
1208             (font-lock-mode-maybe 1))
1209         (setq font-lock-keywords keywords))))))
1210
1211 ;;; ----------------------------------------------------------------------
1212 ;;;
1213 (defun tinydebian-email-at-word (&optional string)
1214   "Read email address if any at current point or from STRING."
1215   (or string
1216       (setq string (thing-at-point 'url)))
1217   (when (and (stringp string)
1218              (string-match "mailto:\\(.+\\)" string))
1219     (match-string 1 string)))
1220
1221 ;;; ----------------------------------------------------------------------
1222 ;;;
1223 (defun tinydebian-email-at-line (&optional string)
1224   "Read email address if any at current line or from STRING."
1225   (or string
1226       (setq string (thing-at-point 'line)))
1227   (when (and (stringp string)
1228              (string-match "[^ <\t\r\n]+@[^ \t\r\n>]+" string))
1229     (match-string 0 string)))
1230
1231 ;;; ----------------------------------------------------------------------
1232 ;;;
1233 (put 'tinydebian-email-gnus-summary-mode-macro 'edebug-form-spec '(body))
1234 (put 'tinydebian-email-gnus-summary-mode-macro 'lisp-indent-function 0)
1235 (defmacro tinydebian-email-gnus-summary-mode-macro (&rest body)
1236   "At current poiint, examine article and run BODY."
1237   `(when (eq major-mode 'gnus-summary-mode)
1238      (let ((article (gnus-summary-article-number))
1239            article-window)
1240        (gnus-summary-display-article article)
1241        (setq article-window (get-buffer-window gnus-article-buffer t))
1242        (gnus-eval-in-buffer-window gnus-article-buffer
1243                                    ,@body))))
1244
1245 ;;; ----------------------------------------------------------------------
1246 ;;;
1247 (defun tinydebian-email-gnus-summary-mode ()
1248   "Read mail address if point is at Gnus summary buffer."
1249   (tinydebian-email-gnus-summary-mode-macro
1250    (tinydebian-email-field-from)))
1251
1252 ;;; ----------------------------------------------------------------------
1253 ;;;
1254 (defun tinydebian-email-field-from ()
1255   "Read From: field and return email."
1256   (let* ((str (mail-fetch-field "From")))
1257     (or (and str
1258              (tinydebian-email-at-line str)))))
1259
1260 ;;; ----------------------------------------------------------------------
1261 ;;;
1262 (defun tinydebian-email-field-to ()
1263   "Read To: field and return email."
1264   (let* ((str (mail-fetch-field "To")))
1265     (or (and str
1266              (tinydebian-email-at-line str)))))
1267
1268 ;;; ----------------------------------------------------------------------
1269 ;;;
1270 (defun tinydebian-email-any (&rest args)
1271   "Try various methods to find email address. Ignore ARGS.
1272 At current point, current line, headers of the mail message."
1273   (or (tinydebian-email-gnus-summary-mode)
1274       (tinydebian-email-at-word)
1275       (tinydebian-email-at-line)
1276       (tinydebian-email-field-from)
1277       (tinydebian-email-field-to)))
1278
1279 ;;; ----------------------------------------------------------------------
1280 ;;;
1281 (defsubst tinydebian-email-search ()
1282   "Call hook `tinydebian-:find-email-hook' until value returned."
1283   (run-hook-with-args-until-success 'tinydebian-:find-email-hook))
1284
1285 ;;; ----------------------------------------------------------------------
1286 ;;;
1287 (defun tinydebian-bug-string-parse-wnpp-alert (str)
1288   "Parse wnpp-alert(1) like line. Return '(bug package bug-type desc)
1289   RFA 321654 debtags -- Enables support for package tags."
1290   (let (case-fold-search)
1291     (when (string-match
1292            (concat
1293             "\\<\\(RF.\\|IT.\\|O\\) +\\([0-9]+\\) +"
1294             "\\([^ \t\r\n]+\\) +-- +\\(.+[^ \t\r\n]\\)")
1295            str)
1296       (list
1297        (match-string 2 str)
1298        (match-string 3 str)
1299        (match-string 1 str)
1300        (match-string 4 str)))))
1301
1302 ;;; ----------------------------------------------------------------------
1303 ;;;
1304 (defun tinydebian-bug-nbr-string (str)
1305   "Read bug nbr from STR."
1306   (or (and (string-match "#\\([0-9]+\\)" str)
1307            (match-string 1 str))
1308       (multiple-value-bind (bug)
1309           (tinydebian-bug-string-parse-wnpp-alert str)
1310         bug)
1311       ;;   NNNN@bugs.debian.org
1312       (and (string-match (concat "\\([0-9]+\\)\\(?:-[a-z]+\\)?@"
1313                                  tinydebian-:bts-email-address)
1314                          str)
1315            (match-string 1 str))
1316       ;;   BTS message lines: "owner NNNNNN"
1317       (and (string-match (concat "\\<\\(?:owner\\|retitle\\) "
1318                                  "\\([0-9][0-9][0-9][0-9][0-9][0-9]\\)\\>")
1319                          str)
1320            (match-string 1 str))))
1321
1322 ;;; ----------------------------------------------------------------------
1323 ;;;
1324 (defun tinydebian-bug-nbr-at-current-point ()
1325   "Read bug number with hash (#) mark from current point"
1326   (let ((table (syntax-table))
1327         word)
1328     (with-syntax-table table
1329       (modify-syntax-entry ?# "w" table)
1330       (tinydebian-bug-nbr-string (current-word)))))
1331
1332 ;;; ----------------------------------------------------------------------
1333 ;;;
1334 (defsubst tinydebian-bug-nbr-any-at-current-point ()
1335   "Read bug number NNNNNN from current point"
1336   (let ((str (current-word)))
1337     (if (string-match
1338          "\\([^0-9]\\|^\\)\\([0-9][0-9][0-9][0-9][0-9][0-9]\\)$"
1339          str)
1340         (match-string 2 str))))
1341
1342 ;;; ----------------------------------------------------------------------
1343 ;;;
1344 (defsubst tinydebian-bug-nbr-current-line ()
1345   "Read bug number from current line"
1346   (let* ((line (buffer-substring-no-properties
1347                 (line-beginning-position)
1348                 (line-end-position))))
1349     (tinydebian-bug-nbr-string line)))
1350
1351 ;;; ----------------------------------------------------------------------
1352 ;;;
1353 (defsubst tinydebian-bug-nbr-forward (&optional regexp)
1354   "Read bug#NNNN from current point forward.
1355 If optional REGEXP is sebt, it must take number in submatch 1."
1356   (tinydebian-buffer-match-string (or regexp "Bug#\\([0-9]+\\)")))
1357
1358 ;;; ----------------------------------------------------------------------
1359 ;;;
1360 (defsubst tinydebian-bug-hash-forward ()
1361   "Search #NNNN forward."
1362   (tinydebian-bug-nbr-forward "#\\([0-9]+\\)"))
1363
1364 ;;; ----------------------------------------------------------------------
1365 ;;;
1366 (defsubst tinydebian-bug-nbr-buffer (&optional regexp)
1367   "Read bug#NNNN or REGEXP from buffer."
1368   (save-excursion
1369     (goto-char (point-min))
1370     (tinydebian-bug-nbr-forward)))
1371
1372 ;;; ----------------------------------------------------------------------
1373 ;;;
1374 (defsubst tinydebian-bug-hash-buffer ()
1375   "Search #NNNN from buffer."
1376   (tinydebian-bug-nbr-buffer "#\\([0-9]+\\)"))
1377
1378 ;;; ----------------------------------------------------------------------
1379 ;;;
1380 (defsubst tinydebian-email-cc-to-bug-nbr ()
1381   "Read BTS number from CC or To"
1382   (let* ((str (mail-fetch-field "To")))
1383     (or (and str
1384              (tinydebian-bug-nbr-string str))
1385         (and (setq str (mail-fetch-field "Cc"))
1386              (tinydebian-bug-nbr-string str)))))
1387
1388 ;;; ----------------------------------------------------------------------
1389 ;;;
1390 (defsubst tinydebian-email-subject-bug-nbr ()
1391   "Read BTS number from Subject"
1392   (let* ((subject (mail-fetch-field "Subject")))
1393     (and subject
1394          (tinydebian-bug-nbr-string subject))))
1395
1396 ;;; ----------------------------------------------------------------------
1397 ;;;
1398 (defun tinydebian-bug-nbr-any (&rest args)
1399   "Try various methods to find bug tracking number. Ignore ARGS.
1400 At current point, current line, headers of the mail message
1401 (CC, To, Subject), forward from point, whole buffer."
1402   (or (tinydebian-bug-nbr-at-current-point)
1403       (tinydebian-bug-nbr-current-line)
1404       (tinydebian-email-cc-to-bug-nbr)
1405       (tinydebian-email-subject-bug-nbr)
1406       (tinydebian-bug-nbr-forward)
1407       (tinydebian-bug-nbr-buffer)
1408       (tinydebian-bug-hash-forward)
1409       (tinydebian-bug-hash-buffer)
1410       (tinydebian-bug-nbr-any-at-current-point)))
1411
1412 ;;; ----------------------------------------------------------------------
1413 ;;;
1414 (defsubst tinydebian-bug-nbr-search ()
1415   "Call hook `tinydebian-:find-bug-nbr-hook' until value returned."
1416   (run-hook-with-args-until-success 'tinydebian-:find-bug-nbr-hook))
1417
1418 ;;; ----------------------------------------------------------------------
1419 ;;;
1420 (defun tinydebian-bug-package-name-header-pool ()
1421   "Search Filename: pool/main/p/<package>."
1422   (tinydebian-buffer-match-string
1423    "^Filename: pool.*/\\([^/ \t\r\n]+\\)/"
1424    (point-min)))
1425
1426 ;;; ----------------------------------------------------------------------
1427 ;;;
1428 (defun tinydebian-bug-package-name-header-package ()
1429   "Search Package: <package>."
1430   (tinydebian-buffer-match-string
1431    "^Package: +\\([^/ \t\r\n]+\\)/"
1432    (point-min)))
1433
1434 ;;; ----------------------------------------------------------------------
1435 ;;;
1436 (defun tinydebian-bts-parse-string-with-bug (str)
1437   "Return '(bug type package description) for common matches."
1438   (let (bug
1439         type
1440         package
1441         desc
1442         case-fold-search)
1443     (cond
1444      ((string-match "\\<\\([A-Z][A-Z][A-Z]\\|O\\): *\\(.*\\)" str)
1445       (setq type (match-string 1 str)
1446             desc (match-string 2 str)
1447             bug  (tinydebian-bug-nbr-string str))
1448       (when (string-match "^\\([a-z].+\\) +--+ *\\(.*\\)" desc)
1449         (setq package (match-string 1 desc)
1450               desc    (match-string 2 desc))))
1451      ((string-match "Bug#\\([0-9]+\\): *\\(.*\\)" str)
1452       (setq bug  (match-string 1 str)
1453             desc (match-string 2 str))))
1454     (list bug type package desc)))
1455
1456 ;;; ----------------------------------------------------------------------
1457 ;;;
1458 (defun tinydebian-bts-parse-string-with-package (str)
1459   "Return '(package description) for common matches."
1460   (let (case-fold-search)
1461     (cond
1462      ((string-match
1463        "[fF]ixed in\\(?: NMU of\\)? \\([a-z][^ \t\r\n]+\\) +\\(.*\\)" str)
1464       (list (match-string 1 str)
1465             str))
1466      ((string-match "^\\([a-z][a-z0-9-]+\\): +\\(.*\\)" str)
1467       (list (match-string 1 str)
1468             (match-string 2 str))))))
1469
1470 ;;; ----------------------------------------------------------------------
1471 ;;; (tinydebian-bts-parse-string-1 "Bug#353353: RFP: appweb -- very ...")
1472 ;;; (tinydebian-bts-parse-string-1 "Bug#352429: marked as done (ITA: cdrdao  -- records CDs in Disk-At-Once (DAO) mode)")
1473 ;;; (tinydebian-bts-parse-string-1 "Bug#351502: fixed in nvu 1.0final-1")
1474 ;;; (tinydebian-bts-parse-string-1 "Bug#352533: Fixed in NMU of sa-exim 4.2-3")
1475 ;;; (tinydebian-bts-parse-string-1 "Bug#244582: UFO:AI is back")
1476 ;;; (tinydebian-bts-parse-string-1 "")
1477 ;;; (tinydebian-bts-parse-string-1 "")
1478 (defun tinydebian-bts-parse-string-1 (str)
1479   "Parse STR and Return '(bug type package description)."
1480   (when (stringp str)
1481     ;;  Treat long "folded" subject like:
1482     ;;
1483     ;;  Subject: Bug#353588 acknowledged by developer (Re: Bug#353588: lintian:
1484     ;;     [add new rule] check debian/control::Description better ...
1485     ;;
1486     (setq str
1487           (replace-regexp-in-string "[\r\n]+" " " str))
1488     (multiple-value-bind (bug type package desc)
1489         (tinydebian-bts-parse-string-with-bug str)
1490       (when (and (not package)
1491                  desc)
1492         (multiple-value-bind (ret-pkg ret-desc)
1493             (tinydebian-bts-parse-string-with-package desc)
1494           (setq package ret-pkg
1495                 desc    ret-desc)))
1496       (if (and (stringp desc)
1497                (string= desc ""))
1498           (setq desc nil))
1499       (if (and bug desc)
1500           (list bug type package desc)))))
1501
1502 ;;; ----------------------------------------------------------------------
1503 ;;;
1504 (defsubst tinydebian-bts-parse-string-current-line ()
1505   (let ((str (buffer-substring-no-properties
1506               (line-beginning-position)
1507               (line-end-position))))
1508     (tinydebian-bts-parse-string-1 str)))
1509
1510 ;;; ----------------------------------------------------------------------
1511 ;;;
1512 (defsubst tinydebian-bts-parse-string-subject ()
1513   (let ((str (mail-fetch-field "Subject")))
1514     (when str
1515       (tinydebian-bts-parse-string-1 str))))
1516
1517 ;;; ----------------------------------------------------------------------
1518 ;;;
1519 (defun tinydebian-bug-package-name-current-line ()
1520   (let* ((line (buffer-substring-no-properties
1521                 (line-beginning-position)
1522                 (line-end-position))))
1523     (when line
1524       (multiple-value-bind (bug package)
1525           (tinydebian-bug-string-parse-wnpp-alert line)
1526         package))))
1527
1528 ;;; ----------------------------------------------------------------------
1529 ;;;
1530 (defun my-debian-bug-package-name-any ()
1531   "Search package name."
1532   (or (tinydebian-bug-package-name-current-line)
1533       (tinydebian-bug-package-name-header-pool)
1534       (tinydebian-bug-package-name-header-package)
1535       (progn
1536         (multiple-value-bind (bug type-orig package description)
1537             (tinydebian-bts-parse-string-subject)
1538           package))))
1539
1540 ;;; ----------------------------------------------------------------------
1541 ;;;
1542 (defun tinydebian-gnus-summary-subject ()
1543   "In Gnus *Summary* buffer return current subject."
1544   (tinydebian-email-gnus-summary-mode-macro
1545    (mail-fetch-field "Subject")))
1546
1547 ;;; ----------------------------------------------------------------------
1548 ;;;
1549 (defun my-tinydebian-subject-any ()
1550   "Try to find subject for mail message."
1551   (or (tinydebian-gnus-summary-subject)))
1552
1553 ;;; ----------------------------------------------------------------------
1554 ;;;
1555 (defsubst tinydebian-email-subject-type-parse ()
1556   "Read BTS Subject and return '(TYPE SUBJECT)"
1557   (let* ((subject (mail-fetch-field "Subject")))
1558     (when subject
1559       ;;  Bug#292579: marked as done (RFP: miwm -- MIcroscopic Window
1560       (let (type subject bug)
1561         (when (string-match "\\(?: (?\\)\\([a-z]+\\):\\(.*\\)" subject)
1562           (setq type    (match-string 1 subject)
1563                 subject (match-string 2 subject)))
1564         (setq bug
1565               (tinydebian-bug-nbr-string subject))
1566         (list type subject bug)))))
1567
1568 ;;; ----------------------------------------------------------------------
1569 ;;;
1570 (defun tinydebian-browse-url-browse-url (url &rest args)
1571   "Call `browse-url' and ignore ARGS."
1572   (browse-url url))
1573
1574 ;;; ----------------------------------------------------------------------
1575 ;;;
1576 (defun tinydebian-browse-url-lisp-only (url &optional bug)
1577   "Open HTTP connection to URL and read result.
1578   If BUG is set, then read specific BUG page and create buffer for it.
1579   If buffer already exists, do nothing."
1580   (ti::process-http-request url (not 'port) (not 'timeout)))
1581
1582 ;;; ----------------------------------------------------------------------
1583 ;;;
1584 (defun tinydebian-browse-url-lynx-dump (url &optional mode)
1585   "Run lynx(1) with option -dump using URL.
1586   Optional MODE is hint to activate `tinydebian-bts-mode' on text buffer"
1587   ;;  For fast lookup, record the binary's full path
1588   (unless (get 'tinydebian-browse-url-lynx-dump 'done)
1589     (put 'tinydebian-browse-url-lynx-dump 'done t)
1590     (put 'tinydebian-browse-url-lynx-dump 'program (executable-find "lynx")))
1591   (let ((path (get 'tinydebian-browse-url-lynx-dump 'program)))
1592     (if (not path)
1593         (error "TinyDebian: [ERROR] `lynx' not found in PATH for %s" url)
1594       (tinydebian-with-buffer-macro tinydebian-:buffer-www
1595                                     (message "TinyDebian: Wait, accessing %s" url)
1596                                     (tinydebian-call-process path nil "-dump" url)
1597                                     (when mode
1598                                       (turn-on-tinydebian-bts-mode)
1599                                       (let ((font (tinydebian-url-page-font-lock-keywords mode)))
1600                                         (when (and font
1601                                                    (or tinydebian-:font-lock-mode
1602                                                        global-font-lock-mode))
1603                                           (setq font-lock-keywords font)
1604                                           (font-lock-mode 1))))
1605                                     (goto-char (point-min))
1606                                     (display-buffer (current-buffer))))))
1607
1608 ;;; ----------------------------------------------------------------------
1609 ;;;
1610 (defun tinydebian-browse-url-1 (url &optional mode)
1611   "Call `tinydebian-:browse-url-function' with URL.
1612   Optional MODE is hint to activate `tinydebian-bts-mode' on result buffer."
1613   (if tinydebian-:browse-url-function
1614       (funcall tinydebian-:browse-url-function url mode)
1615     (tinydebian-browse-url-browse-url url)))
1616
1617 ;;; ----------------------------------------------------------------------
1618 ;;;
1619 (defun tinydebian-bug-browse-url-by-bug (bug &optional file)
1620   "Browse by BUG number. Optionally save bug report to FILE.
1621   A prefix argument in interactive mode prompts for FILE to save."
1622   (interactive
1623    (let* ((prev (get 'tinydebian-bug-browse-url-by-bug 'file))
1624           (dir  (if prev
1625                     (file-name-directory prev)))
1626           (nbr  (read-string "Browse URL by bug number: "
1627                              (tinydebian-bug-nbr-search)))
1628           (name (if current-prefix-arg
1629                     (read-file-name
1630                      (format "Save bug %s to file: " nbr)
1631                      dir
1632                      nil
1633                      nil
1634                      (format "%s.txt" nbr)))))
1635      (put 'tinydebian-bug-browse-url-by-bug 'file name)
1636      (list nbr name)))
1637   (when (or (not (stringp bug))
1638             (not (string-match "^[0-9]+$" bug)))
1639     (error "TinyDebian: Invalid bug number `%s'." bug))
1640   (let ((tinydebian-:browse-url-function tinydebian-:browse-url-function))
1641     (if file
1642         (setq tinydebian-:browse-url-function
1643               (function tinydebian-browse-url-lynx-dump)))
1644     (tinydebian-browse-url-1
1645      (format "http://bugs.debian.org/%s"
1646              (if (numberp bug)
1647                  (int-to-string bug)
1648                bug)))
1649     (if file
1650         (with-current-buffer (get-buffer tinydebian-:buffer-www)
1651           (write-region (point-min) (point-max) file)
1652           (if (interactive-p)
1653               (message "Wrote %s" file))
1654           file)
1655       tinydebian-:buffer-www)))
1656
1657 ;;; ----------------------------------------------------------------------
1658 ;;;
1659 (defsubst tinydebian-bug-buffer-name (bug)
1660   (or bug
1661       (error "TinyDebian: BUG argument is empty"))
1662   (format tinydebian-:buffer-bug-format bug))
1663
1664 ;;; ----------------------------------------------------------------------
1665 ;;;
1666 (defsubst tinydebian-url-debian-bugs (string)
1667   "Return bugs URL."
1668   (format "%s/%s" tinydebian-:url-http-package-bugs string))
1669
1670 ;;; ----------------------------------------------------------------------
1671 ;;;
1672 (defun tinydebian-bug-buffer-or-retrieve (bug)
1673   "Return buffer for BUG or send HTTP request to read bug.
1674   Return:
1675   buffer name"
1676   (or bug
1677       (error "TinyDebian: BUG argument is empty"))
1678   (let* ((name   (tinydebian-bug-buffer-name bug))
1679          (buffer (get-buffer name))
1680          (url    (tinydebian-url-debian-bugs bug)))
1681     (if buffer
1682         buffer
1683       (setq buffer (get-buffer-create name))
1684       (ti::process-http-request url (not 'port) (not 'timeout) buffer)
1685       buffer)))
1686
1687 ;;; ----------------------------------------------------------------------
1688 ;;;
1689 (defun tinydebian-bug-browse-url-by-package-name (package)
1690   "Jump to PACKAGE description."
1691   (interactive
1692    (list (read-string "Browse desription URL by package name: "
1693                       (my-debian-bug-package-name-any))))
1694   (when (or (not (stringp package))
1695             (not (string-match "[a-z]" package)))
1696     (error "TinyDebian: Invalid package name `%s'." package))
1697   (tinydebian-browse-url-1
1698    (tinydebian-packages-browse-url-compose package)
1699    package))
1700
1701 ;;; ----------------------------------------------------------------------
1702 ;;;
1703 (defun tinydebian-bug-browse-url-by-package-bugs (package)
1704   "Jump to PACKAGE description."
1705   (interactive
1706    (list (read-string "Browse bugs URL by package name: "
1707                       (my-debian-bug-package-name-any))))
1708   (when (or (not (stringp package))
1709             (not (string-match "[a-z]" package)))
1710     (error "TinyDebian: Invalid package name `%s'." package))
1711   (tinydebian-browse-url-1
1712    (tinydebian-url-debian-bugs package)
1713    package))
1714
1715 ;;; ----------------------------------------------------------------------
1716 ;;;
1717 (defun tinydebian-command-show-wnpp-alert-format ()
1718   "Convert lines to more readable format from current point.
1719
1720   Original:
1721
1722   RFH 354176 cvs -- Concurrent Versions System
1723   O 367169 directvnc -- VNC client using the framebuffer as display
1724
1725   After formatting:
1726
1727   RFH 354176 cvs       -- Concurrent Versions System
1728   O   367169 directvnc -- VNC client using the framebuffer as display"
1729   (let ((re (concat
1730              "\\([a-z]+\\) +\\([0-9]+\\) +\\([^ \t\r\n]+\\)"
1731              " +-- +\\(.*\\)")))
1732     (while (re-search-forward re nil t)
1733       (replace-match (format "%-3s %d %-12s -- %s"
1734                              (match-string 1)
1735                              (match-string 2)
1736                              (match-string 3)
1737                              (match-string 4))))))
1738
1739 ;;; ----------------------------------------------------------------------
1740 ;;;
1741 (defun tinydebian-command-show-wnpp-alert ()
1742   "Check for installed packages up for adoption or orphaned.
1743   Requires that program wnpp-alert(1) has been installed."
1744   (interactive)
1745   (let* ((bin  "wnpp-alert")
1746          (path (executable-find bin)))
1747     (cond
1748      ((not bin)
1749       (message "TinyDebian: [ERROR] program `%s' is not installed."
1750                bin))
1751      (t
1752       (tinydebian-with-buffer-macro tinydebian-:buffer-wnpp-alert
1753                                     (message "TinyDebian: wait, running %s..." path)
1754                                     (tinydebian-call-process path)
1755                                     (message "TinyDebian: wait, running %s... Done." path)
1756                                     (goto-char (point-min))
1757                                     (save-excursion
1758                                       (tinydebian-command-show-wnpp-alert))
1759                                     (turn-on-tinydebian-bts-mode)
1760                                     (display-buffer buffer)
1761                                     buffer)))))
1762
1763 ;;}}}
1764 ;;{{{ BTS URL pages
1765
1766 ;;; ----------------------------------------------------------------------
1767 ;;;
1768 (put 'tinydebian-with-url-page-type-macro 'edebug-form-spec '(body))
1769 (put 'tinydebian-with-url-page-type-macro 'lisp-indent-function 1)
1770 (defmacro tinydebian-with-url-page-type-macro (page-type &rest body)
1771   "Retrieve PAGE-TYPE from `tinydebian-:url-debian-page-alist' and run BODY.
1772   Variable `page'is bound to the retrieved value.
1773   Signal error if PAGE-TYPE is not found."
1774   `(let ((page (assoc ,page-type tinydebian-:url-debian-page-alist)))
1775      (unless page
1776        (error "TinyDebian: unknown page-typpe `%s'" ,page-type))
1777      ,@body))
1778
1779 ;;; ----------------------------------------------------------------------
1780 ;;;
1781 (defsubst tinydebian-url-page-compose (page-type)
1782   "Return URL location of PAGE-TYPE."
1783   (tinydebian-with-url-page-type-macro page-type (nth 1 page)))
1784
1785 ;;; ----------------------------------------------------------------------
1786 ;;;
1787 (defsubst tinydebian-url-page-font-lock-keywords (page-type)
1788   "Return `font-lock-keywords' of PAGE-TYPE."
1789   (tinydebian-with-url-page-type-macro page-type (nth 2 page)))
1790
1791 ;;; ----------------------------------------------------------------------
1792 ;;;
1793 (defsubst tinydebian-url-debian-mentors-url (package &optional section)
1794   "Return PACKAGE URL to mentors.debian.net in optional SECTION (def. main)."
1795   (let* ((first-char (substring package 0 1)))
1796     (format "%s/%s/%s/%s"
1797             (tinydebian-url-page-compose 'mentors-pkg-pool)
1798             (or section "main")
1799             first-char
1800             package)))
1801
1802 ;;; ----------------------------------------------------------------------
1803 ;;;
1804 (defun tinydebian-url-debian-browse-url (page-type &optional mode)
1805   "Browse Debian pages.
1806   Optional MODE is hint to activate `tinydebian-bts-mode' on result buffer."
1807   (let ((url (tinydebian-url-page-compose page-type)))
1808     (unless url
1809       (error "TinyDebian: Unknown URL request `%s'." page-type))
1810     (cond
1811      ((and (tinydebian-string-p url)
1812            (string-match "^/" url))
1813       (when (and (string-match "z$" url)
1814                  (null auto-compression-mode))
1815         (auto-compression-mode 1))
1816       (if (file-exists-p url)
1817           (find-file-other-window url)
1818         (error "TinyDebian: need 'apt-get install ...' (not found %s)"
1819                url)))
1820      ((string-match ":" url)
1821       (tinydebian-browse-url-1 url mode)))
1822     (t
1823      (error "TinyDebian: browse internal error `%s' `%s' `%s'"
1824             page-type mode url))))
1825
1826 ;;; ----------------------------------------------------------------------
1827 ;;;
1828 (defun tinydebian-url-bts-ctrl-page ()
1829   "Browse BTS control page."
1830   (interactive)
1831   (tinydebian-url-debian-browse-url 'bts-control))
1832
1833 ;;; ----------------------------------------------------------------------
1834 ;;;
1835 (defun tinydebian-url-policy-new-maintainer-guide ()
1836   "Browse Debian New Maintainers' Guide."
1837   (interactive)
1838   (tinydebian-url-debian-browse-url 'newmaint-guide))
1839
1840 ;;; ----------------------------------------------------------------------
1841 ;;;
1842 (defun tinydebian-url-policy-best-practises ()
1843   "Browse  Debian Developer's Reference Chapter 6 - Best Packaging Practices."
1844   (interactive)
1845   (tinydebian-url-debian-browse-url 'best-practices))
1846
1847 ;;; ----------------------------------------------------------------------
1848 ;;;
1849 (defun tinydebian-url-policy-developers-reference (&optional text-file)
1850   "Browse  Debian Developer's Reference.
1851   Optionally use TEXT-FILE from /usr/share/doc if found."
1852   (interactive "P")
1853   (tinydebian-url-debian-browse-url
1854    (if text-file
1855        'developers-reference-text
1856      'developers-reference)))
1857
1858 ;;; ----------------------------------------------------------------------
1859 ;;;
1860 (defun tinydebian-url-policy-manual (&optional text-file)
1861   "Browse policy manual page.
1862   Optionally use TEXT-FILE from /usr/share/doc if found."
1863   (interactive "P")
1864   (tinydebian-url-debian-browse-url
1865    (if text-file
1866        'policy-text
1867      'policy)))
1868
1869 ;;; ----------------------------------------------------------------------
1870 ;;;
1871 (defun tinydebian-url-policy-best-practises ()
1872   "Browse policy manual page: best practises section."
1873   (interactive)
1874   (tinydebian-url-debian-browse-url 'best-practises))
1875
1876 ;;; ----------------------------------------------------------------------
1877 ;;;
1878 (defun tinydebian-url-list-bugs-by-rc ()
1879   "Browse release critical bugs."
1880   (interactive)
1881   (tinydebian-url-debian-browse-url 'bugs-rc 'bugs-rc))
1882
1883 ;;; ----------------------------------------------------------------------
1884 ;;;
1885 (defun tinydebian-url-list-package-debcheck (package &optional distribution)
1886   "Check package for debcheck problems.
1887   Optionally from DISTRIBUTION which defaults to `testing'."
1888   (interactive
1889    (list
1890     (read-string "Debcheck package: ")
1891     (completing-read "Distribution: "
1892                      '(("stable" . 1)
1893                        ("testing" . 1)
1894                        ("unstable" . 1)
1895                        ("experimental" . 1))
1896                      (not 'predicate)
1897                      (not 'require-match))))
1898   (when (and (stringp package)
1899              (not (string= "" package)))
1900     (tinydebian-url-debian-browse-url-1
1901      (format (tinydebian-url-page-compose 'debcheck-package)
1902              (or distribution  "testing")
1903              package))))
1904
1905 ;;; ----------------------------------------------------------------------
1906 ;;;
1907 (defun tinydebian-url-list-qa-developer-status (email)
1908   "Browse QA developer status information by EMAIL address."
1909   (interactive
1910    (list (read-string "[QA status] developer's email address: "
1911                       (tinydebian-email-search))))
1912   (tinydebian-string-p
1913    email
1914    (format "[ERROR] email is missing from input [%s]" email))
1915   (tinydebian-browse-url-1
1916    (format "%slogin=%s" (tinydebian-url-page-compose 'qa-developer-status) email)))
1917
1918 ;;; ----------------------------------------------------------------------
1919 ;;;
1920 (defun tinydebian-url-list-qa-developer-bugs (email)
1921   "Browse QA developer bugs information by EMAIL address."
1922   (interactive
1923    (list (read-string "[QA bugs] developer's email address:"
1924                       (tinydebian-email-search))))
1925   (tinydebian-string-p
1926    email
1927    (format "[ERROR] email is missing from input [%s]" email))
1928   (tinydebian-browse-url-1
1929    (format "%ssubmitter=%s" (tinydebian-url-page-compose 'qa-developer-bugs) email)))
1930
1931 ;;; ----------------------------------------------------------------------
1932 ;;;
1933 (defun tinydebian-url-list-dsfg-license-faq ()
1934   "Browse DFSG FAQ about Licenses."
1935   (interactive)
1936   (tinydebian-browse-url-1 (tinydebian-url-page-compose 'dfsg-license-faq)))
1937
1938 ;;; ----------------------------------------------------------------------
1939 ;;;
1940 (defun tinydebian-url-list-base-files-faq ()
1941   "Browse base-files FAQ."
1942   (interactive)
1943   (tinydebian-browse-url-1 (tinydebian-url-page-compose 'base-files-faq)))
1944
1945 ;;; ----------------------------------------------------------------------
1946 ;;;
1947 (defun tinydebian-url-list-package-by-filename (filename &optional arch)
1948   "Package content search by FILENAME and optional ARCH."
1949   (interactive
1950    (let ((name (read-string "[Pkg search] filename: "))
1951          (arch (read-string "[Pkg search] architecture [RET=all]: ")))
1952      (list name arch)))
1953   (tinydebian-string-p
1954    filename
1955    (format "[ERROR] filename is missing from input [%s]" filename))
1956   ;; http://packages.debian.org/cgi-bin/search_contents.pl?word=svn_load_dirs&searchmode=searchfiles&case=insensitive&version=stable&arch=i386
1957   (tinydebian-browse-url-1
1958    (format "%s%s&word=%s"
1959            (tinydebian-url-page-compose 'pkg-search-files)
1960            (if (tinydebian-string-p arch)
1961                (format "&arch=%s" arch)
1962              "")
1963            filename)))
1964
1965 (defun tinydebian-grep-find-debian-devel (regexp grep-opt)
1966   "Grep REGEXP from all ddevelopment text files (policy etc.)"
1967   (interactive "sRegexp: \nsGrep opt (no single quotes): ")
1968   (let ((path-list (mapconcat
1969                     'concat
1970                     (delq nil
1971                           tinydebian-:grep-find-devel-docdir-list)
1972                     " "))
1973         cmd)
1974     (setq cmd
1975           (format
1976            (concat
1977             "find %s -type f -name '*.txt.gz' -print0 "
1978             "| xargs -0 -e zgrep -n %s '%s'")
1979            path-list
1980            grep-opt
1981            regexp))
1982     (grep-find cmd)))
1983
1984 ;;}}}
1985 ;;{{{ WNPP URLs
1986
1987 ;;; ----------------------------------------------------------------------
1988 ;;;
1989 (defsubst tinydebian-url-wnpp-compose (page-type)
1990   "Return URL to search"
1991   (let ((page (assoc page-type tinydebian-:url-http-wnpp-page-alist)))
1992     (unless page
1993       (error "TinyDebian: unknow page-typpe `%s'" page-type))
1994     (format "%s/%s" tinydebian-:url-http-wnpp-page-main (cdr page))))
1995
1996 ;;; ----------------------------------------------------------------------
1997 ;;;
1998 (defsubst tinydebian-url-usertag-compose (tag)
1999   "Return URL to search"
2000   (format "%s/usertag:%s" tinydebian-:url-http-debian-www tag))
2001
2002 ;;; ----------------------------------------------------------------------
2003 ;;;
2004 (defsubst tinydebian-url-wnpp-browse-url (page-type)
2005   "Browse WNPP PAGE-TYPE."
2006   (tinydebian-browse-url-1 (tinydebian-url-wnpp-compose page-type)))
2007
2008 ;;; ----------------------------------------------------------------------
2009 ;;;
2010 (defun tinydebian-url-list-bugs-by-usertag (usertag)
2011   "Browse by USERTAG."
2012   (interactive "sUsertag to search: ")
2013   (tinydebian-string-p
2014    usertag
2015    (format "[ERROR] usertag is missing from input [%s]" usertag))
2016   (tinydebian-browse-url-1 (tinydebian-url-usertag-compose usertag)))
2017
2018 ;;; ----------------------------------------------------------------------
2019 ;;;
2020 (defun tinydebian-url-list-wnpp-itp ()
2021   "Browse WNPP ITP page."
2022   (interactive)
2023   (tinydebian-url-wnpp-browse-url "ITP"))
2024
2025 ;;; ----------------------------------------------------------------------
2026 ;;;
2027 (defun tinydebian-url-list-wnpp-rfp ()
2028   "Browse WNPP RFP page."
2029   (interactive)
2030   (tinydebian-url-wnpp-browse-url "RFP"))
2031
2032 ;;; ----------------------------------------------------------------------
2033 ;;;
2034 (defun tinydebian-url-list-wnpp-rfh ()
2035   "Browse WNPP RFH page."
2036   (interactive)
2037   (tinydebian-url-wnpp-browse-url "RFH"))
2038
2039 ;;; ----------------------------------------------------------------------
2040 ;;;
2041 (defun tinydebian-url-list-wnpp-rfa ()
2042   "Browse WNPP RFA page."
2043   (interactive)
2044   (tinydebian-url-wnpp-browse-url "RFA"))
2045
2046 ;;; ----------------------------------------------------------------------
2047 ;;;
2048 (defun tinydebian-url-list-wnpp-orphaned ()
2049   "Browse WNPP orphaned page."
2050   (interactive)
2051   (tinydebian-url-wnpp-browse-url "O"))
2052
2053 ;;}}}
2054 ;;{{{ BTS functions: Debian Developer interface to bug tracking system
2055
2056 ;;; ----------------------------------------------------------------------
2057 ;;;
2058 (defun tinydebian-bts-insert-headers ()
2059   "Insert tinydebian-:bts-extra-headers' to mail buffer."
2060   (let ((headers tinydebian-:bts-extra-headers))
2061     (when (stringp headers)
2062       (save-excursion
2063         (goto-char (point-min))
2064         (when (search-forward mail-header-separator nil t)
2065           (forward-line 0)
2066           (insert headers))))))
2067
2068 ;;; ----------------------------------------------------------------------
2069 ;;;
2070 (put 'tinydebian-bts-mail-compose-macro 'edebug-form-spec '(body))
2071 (put 'tinydebian-bts-mail-compose-macro 'lisp-indent-function 5)
2072 (defmacro tinydebian-bts-mail-compose-macro
2073   (bug type package subject email &rest body)
2074   "Compose mail with SUBJECT and run BODY."
2075   (let ((name (gensym "name-")))
2076     `(let ((,name (format "*Mail Debian BTS %s*"
2077                           (cond
2078                            ((and ,bug ,type ,package)
2079                             (format "%s %s %s"
2080                                     ,type ,package ,bug))
2081                            ((and ,bug ,package)
2082                             (format "%s %s"
2083                                     ,package ,bug))
2084                            (t
2085                             (or ,bug
2086                                 ,subject
2087                                 ""))))))
2088        (pop-to-buffer (get-buffer-create ,name))
2089        (erase-buffer)
2090        (mail-setup
2091         (if ,email
2092             ,email
2093           (tinydebian-bts-email-compose "control"))
2094         ,subject
2095         nil
2096         nil
2097         nil
2098         nil)
2099        (cond
2100         ((or (featurep 'message)
2101              (eq mail-user-agent 'message-user-agent))
2102          (message-mode))
2103         (t
2104          (mail-mode)))
2105        (tinydebian-bts-insert-headers)
2106        ,@body)))
2107
2108 ;;; ----------------------------------------------------------------------
2109 ;;;
2110 (put 'tinydebian-bts-mail-type-macro 'edebug-form-spec '(body))
2111 (put 'tinydebian-bts-mail-type-macro 'lisp-indent-function 4)
2112 (defmacro tinydebian-bts-mail-type-macro (type pkg email subject &rest body)
2113   "Compose a TYPE request and run BODY.
2114 Variables available: bugnbr, type-orig, package, description; but these
2115 can all be nil."
2116   (let ((subj (gensym "subject-")))
2117     `(multiple-value-bind (bugnbr type-orig package description)
2118          (or (tinydebian-bts-parse-string-current-line)
2119              (tinydebian-bts-parse-string-subject))
2120        (if (stringp ,pkg) ;; Use input argument
2121            (setq package ,pkg))
2122        (let ((,subj (or ,subject
2123                         (if ,type
2124                             (format "%s: %s%s"
2125                                     ,type
2126                                     (if package
2127                                         (format "%s -- " package)
2128                                       "")
2129                                     (or description ""))
2130                           ""))))
2131          (tinydebian-bts-mail-compose-macro
2132           bugnbr
2133           ,type
2134           package
2135           ,subj
2136           ,email
2137           (goto-char (point-max))
2138           ,@body)))))
2139
2140 ;;; ----------------------------------------------------------------------
2141 ;;;
2142 (defsubst tinydebian-bts-mail-ask-bug-number (&optional type)
2143   "Ask bug number. Return as '(bug) suitable for interactive"
2144   (read-string
2145    (format "Debian BTS %sbug number: "
2146            (if type
2147                (concat type " ")
2148              ""))
2149    (tinydebian-bug-nbr-any)))
2150
2151 ;;; ----------------------------------------------------------------------
2152 ;;;
2153 (defun tinydebian-bts-mail-type-ita (bug)
2154   "Send an ITA request."
2155   (interactive (list (tinydebian-bts-mail-ask-bug-number "ITA")))
2156   (tinydebian-bts-mail-type-macro "ITA" nil nil nil
2157                                   (insert
2158                                    (format "\
2159   retitle %s %s
2160   owner %s !
2161   thanks
2162   "
2163                                            bug
2164                                            (concat "ITA: "
2165                                                    (if package
2166                                                        (format "%s -- " package)
2167                                                      "")
2168                                                    (or description ""))
2169                                            bug))))
2170
2171 ;;; ----------------------------------------------------------------------
2172 ;;;
2173 (defun tinydebian-bts-mail-type-itp (bug)
2174   "Reposnd to RFP with an ITP request."
2175   (interactive
2176    (list (tinydebian-bts-mail-ask-bug-number "ITP response to RFP")))
2177   (tinydebian-bts-mail-type-macro "ITP" nil nil nil
2178                                   (insert
2179                                    (format "\
2180   retitle %s %s
2181   owner %s !
2182   thanks
2183   "
2184                                            bug
2185                                            (concat "ITP: "
2186                                                    (if package
2187                                                        (format "%s -- " package)
2188                                                      "")
2189                                                    (or description ""))
2190                                            bug))))
2191
2192 ;;; ----------------------------------------------------------------------
2193 ;;;
2194 (defun tinydebian-bts-mail-type-reply (bug)
2195   "Reply to bug found at current point or line"
2196   (interactive (list (tinydebian-bts-mail-ask-bug-number "Reply to bug")))
2197   (let ((subject (my-tinydebian-subject-any)))
2198     (tinydebian-bts-mail-compose-macro
2199      bug
2200      "reply"
2201      "bug"
2202      subject
2203      (tinydebian-bts-email-compose bug)
2204      (mail-position-on-field "CC")
2205      (insert (tinydebian-bts-email-compose (format "%s-submitter" bug)))
2206      (goto-char (point-max))
2207      nil)))
2208
2209 ;;; ----------------------------------------------------------------------
2210 ;;;
2211 (defun tinydebian-bts-mail-type-orphan (package license homepage desc)
2212   "Send an orphan request."
2213   (interactive)
2214   (message "tinydebian-bts-mail-type-orphan not yet implemented."))
2215
2216 ;;; ----------------------------------------------------------------------
2217 ;;;
2218 (defun tinydebian-pkg-read-details-directory (directory)
2219   "Assuming a simgle debian package is in DIRECTORY, extract details.
2220   The directory should contain files:
2221   -rw-r--r-- 1 jaalto jaalto  19885 2006-11-19 18:12 pkg_0.2.4-4.diff.gz
2222   -rw-r--r-- 1 jaalto jaalto    605 2006-11-19 18:12 pkg_0.2.4-4.dsc
2223   -rw-r--r-- 1 jaalto jaalto   1106 2006-11-19 18:12 pkg_0.2.4-4_i386.changes
2224   -rw-r--r-- 1 jaalto jaalto 122188 2006-11-19 18:12 pkg_0.2.4-4_i386.deb
2225   -rw-r--r-- 1 jaalto jaalto    339 2006-11-19 18:12 pkg_0.2.4-4_i386.upload
2226   -rw-r--r-- 1 jaalto jaalto    942 2006-11-19 18:12 pkg_0.2.4-4_source.changes
2227   -rw-r--r-- 1 jaalto jaalto 246864 2006-11-19 18:12 pkg_0.2.4.orig.tar.gz
2228
2229   RETURN:
2230   ((pkg-name       . \"pkg\")
2231    (pkg-ver-major  . \"0.2.4\")
2232    (pkg-ver-minor  . \"4\")
2233    (dsc            . \"pkg_0.2.4-4.dsc\")
2234    (deb            . \"pkg_0.2.4-4.dsc\")
2235    "
2236   (let* ()))
2237
2238 ;;; ----------------------------------------------------------------------
2239 ;;;
2240 (defun tinydebian-bts-mail-type-rfs (package license bug desc)
2241   "Send an RFS request: PACKAGE name, package LICENCE and BUG and DESC.
2242    The DESC is short one line description string use in Subject."
2243   (interactive
2244    (let* ((name    (read-string
2245                     "RFP package name [required; lowercase]: ")) ;
2246           (license (tinydebian-read-license "License [required]: "))
2247           (bug      (read-string
2248                      "ITA/ITP bug number [required]: "))
2249           (desc    (read-string
2250                     "One line description [required]: ")))
2251      (list name license bug desc)))
2252   (flet ((replace (regexp str &optional point all)
2253                   (when (and (stringp str)
2254                              (not (string= "" str)))
2255                     (goto-char (or point
2256                                    (point-min)))
2257                     (if all
2258                         (while (re-search-forward regexp nil t)
2259                           (replace-match str 'literal nil nil 1))
2260                       (if (re-search-forward regexp nil t)
2261                           (replace-match str 'literal nil nil 1))))))
2262     (let* ((arg-pkg package) ;; Due to macro which reserves var `package'.
2263            (mentors-url (tinydebian-url-debian-mentors-url package))
2264            (ita-url     (tinydebian-url-debian-bugs bug))
2265            (pkg-url     (tinydebian-url-debian-bugs package)))
2266       (tinydebian-bts-mail-type-macro "RFS"
2267                                       arg-pkg (tinydebian-list-email-compose "debian-mentors") nil
2268                                       (insert tinydebian-:rfs-template)
2269                                       (replace "\\(<package>.*\\)"    package nil 'all)
2270                                       (replace "\\(<bugs:.*\\)"       pkg-url)
2271                                       (replace "\\(<ita:.*\\)"        ita-url)
2272                                       (replace "\\(<mentors:.*\\)"    mentors-url)
2273                                       (replace "\\(<license:.*\\)"    license)
2274                                       (mail-position-on-field "Subject")
2275                                       (beginning-of-line)
2276                                       (replace ": \\(.*\\)"
2277                                                (format "RFS: %s -- %s" package desc)
2278                                                (point))
2279                                       (goto-char (point-max))
2280                                       (run-hooks 'tinydebian-:rfs-hook)))))
2281
2282 ;;; ----------------------------------------------------------------------
2283 ;;;
2284 (defun tinydebian-bts-mail-type-rfp (package license homepage desc)
2285   "Send an ITP request."
2286   (interactive
2287    (let* ((name    (read-string
2288                     "RFP package name [required; lowercase]: "))
2289           (desc    (read-string
2290                     "Package description [required]: "))
2291           (license (completing-read
2292                     "License [required]: "
2293                     (mapcar (lambda (x)
2294                               (cons x 1))
2295                             tinydebian-:wnpp-template-licenses-alist)))
2296           (url     (read-string
2297                     "Project homepage URL [required]: ")))
2298      (list name license url desc)))
2299   (flet ((replace (regexp str &optional point all)
2300                   (when (and (stringp str)
2301                              (not (string= "" str)))
2302                     (goto-char (or point
2303                                    (point-min)))
2304                     (if all
2305                         (while (re-search-forward regexp nil t)
2306                           (replace-match str 'literal nil nil 1))
2307                       (if (re-search-forward regexp nil t)
2308                           (replace-match str 'literal nil nil 1))))))
2309     (let ((arg-pkg package)) ;; Due to macro which reserves var `package'.
2310       (tinydebian-bts-mail-type-macro "ITP"
2311                                       arg-pkg (tinydebian-bts-email-submit) nil
2312                                       (insert tinydebian-:rfp-template)
2313                                       (replace "\\(<package>.*\\)"    package nil 'all)
2314                                       (replace "\\(<homepage:.*\\)"   homepage)
2315                                       (replace "\\(<license:.*\\)"    license)
2316                                       (replace "\\(<short desc>.*\\)" desc)
2317                                       (mail-position-on-field "Subject")
2318                                       (beginning-of-line)
2319                                       (replace ": \\(.*\\)"
2320                                                (format "RFP: %s -- %s" package desc)
2321                                                (point))
2322                                       (goto-char (point-max))
2323                                       (run-hooks 'tinydebian-:rfp-hook)))))
2324
2325 ;;; ----------------------------------------------------------------------
2326 ;;;
2327 (defun tinydebian-bts-mail-ctrl-severity (bug severity)
2328   "Compose BTS control message to a BUG and chnage SEVERITY."
2329   (interactive
2330    (list (tinydebian-bts-mail-ask-bug-number)
2331          (completing-read
2332           "BTS severity: "
2333           tinydebian-:severity-list
2334           nil
2335           'match)))
2336   (tinydebian-bts-mail-type-macro
2337    nil nil nil
2338    (format "Bug#%s Change of severity / %s" bug severity)
2339    (insert
2340     (format "\
2341 severity %s %s
2342 thanks
2343
2344 "
2345             bug
2346             severity))))
2347
2348 ;;; ----------------------------------------------------------------------
2349 ;;;
2350 (defun tinydebian-bts-mail-ctrl-usertag (bug &optional tag-string)
2351   "Compose BTS control message usertag to a BUG with TAG-STRING."
2352   (interactive
2353    (let ((bug (tinydebian-bts-mail-ask-bug-number)))))
2354   (tinydebian-bts-mail-type-macro
2355    nil nil nil
2356    (format "Bug#%s change of usertag %s" bug (or tag-string ""))
2357    (insert
2358     (format "\
2359 usertag %s +
2360 thanks
2361 "
2362             bug))))
2363
2364 ;;; ----------------------------------------------------------------------
2365 ;;;
2366 (defun tinydebian-bts-mail-ctrl-tags (bug tag-string)
2367   "Compose BTS control message to a BUG with TAG-STRING."
2368   (interactive
2369    (let ((bug (tinydebian-bts-mail-ask-bug-number))
2370          tag
2371          list)
2372      (while (or (null tag)
2373                 (not (string= "" tag)))
2374        (setq tag (completing-read
2375                   "BTS tag [RET when done]: "
2376                   tinydebian-:tags-list
2377                   nil
2378                   'match))
2379        (unless (string= "" tag)
2380          (push tag list)))
2381      (list bug
2382            (mapconcat 'concat list " "))))
2383   (tinydebian-bts-mail-type-macro
2384    nil nil nil
2385    (format "Bug#%s change of tags / %s" bug tag-string)
2386    (insert
2387     (format "\
2388 tags %s + %s
2389 thanks
2390
2391 "
2392             bug
2393             tag-string))))
2394
2395 ;;; ----------------------------------------------------------------------
2396 ;;;
2397 (defun tinydebian-bts-mail-ctrl-reassign (bug &optional package)
2398   "Compose BTS control message to a BUG amd reassign PACKAGE."
2399   (interactive
2400    (list (tinydebian-bts-mail-ask-bug-number)
2401          (read-string "Reassign to package: ")))
2402   (tinydebian-bts-mail-type-macro
2403    nil nil nil
2404    (format "Bug#%s%s reassign " bug (if package
2405                                         (format " to package %s"
2406                                                 package)
2407                                       ""))
2408    (insert
2409     (format "\
2410 reassign %s %s
2411 thanks
2412
2413 "
2414             bug
2415             (if (and package
2416                      (not (string= "" package)))
2417                 package
2418               "<to-package>")))))
2419
2420 ;;; ----------------------------------------------------------------------
2421 ;;;
2422 (defun tinydebian-bts-mail-ctrl-retitle (bug title)
2423   "Compose BTS control message to a BUG and change TITLE."
2424   (interactive
2425    (list (tinydebian-bts-mail-ask-bug-number)
2426          (read-string "New title: ")))
2427   (tinydebian-bts-mail-type-macro
2428    nil nil nil
2429    (format "Reassign Bug#%s" bug)
2430    (insert
2431     (format "\
2432 retitle %s %s
2433 thanks
2434
2435 "
2436             bug
2437             title))))
2438
2439 ;;; ----------------------------------------------------------------------
2440 ;;;
2441 (defun tinydebian-bts-mail-ctrl-reopen (bug)
2442   "Compose BTS control message a BUG and reopen it."
2443   (interactive
2444    (list (tinydebian-bts-mail-ask-bug-number)))
2445   (tinydebian-bts-mail-type-macro
2446    nil nil nil
2447    (format "Reopen Bug#%s" bug)
2448    (insert
2449     (format "\
2450 reopen %s !
2451 thanks
2452
2453 "
2454             bug))))
2455
2456 ;;; ----------------------------------------------------------------------
2457 ;;;
2458 (defun tinydebian-bts-mail-ctrl-close (bug &optional package version)
2459   "Compose BTS control message to close BUG.
2460 Optional PACAGE name and VERSION number can be supplied."
2461   (interactive
2462    (let ((bug      (tinydebian-bts-mail-ask-bug-number))
2463          (package  (read-string "Package name [RET=ignore]: "))
2464          version)
2465      (if (tinydebian-string-p package)
2466          (setq version (read-string "Version: "))
2467        (setq package nil))
2468      (list bug
2469            package
2470            (if (tinydebian-string-p version)
2471                version
2472              nil))))
2473   (let* ((email (tinydebian-bts-email-compose (format "%s-done" bug)))
2474          (pkg   package))
2475     (tinydebian-bts-mail-type-macro
2476      nil
2477      pkg
2478      email
2479      (format "Bug#%s Close" bug)
2480      (insert
2481       (if (not (stringp package))
2482           ""
2483         (format "\
2484 Package: %s
2485 Version: %s
2486 "
2487                 package
2488                 (or version "")))
2489       "\nReason for close:\n"))))
2490
2491 ;;; ----------------------------------------------------------------------
2492 ;;;
2493 (defun tinydebian-bts-mail-ctrl-forward-upstream (bug)
2494   "Compose BTS control message: forward BUG report to upstream."
2495   (let* ((email-forward (tinydebian-bts-email-compose
2496                          (format "%s-forwarded" bug)))
2497          (email-bug (tinydebian-bts-email-compose bug)))
2498     (tinydebian-bts-mail-type-macro
2499      nil nil "<upstream address>"
2500      (format "Debian Bug#%s -- forwarded upstream" bug)
2501      (mail-position-on-field "Cc")
2502      (insert (format "%s, %s" email-forward email-bug))
2503      (goto-char (point-max))
2504      (insert
2505       (format "\
2506 \[Please keep the CC]
2507
2508 ")))))
2509
2510 ;;; ----------------------------------------------------------------------
2511 ;;;
2512 (defun tinydebian-bts-mail-ctrl-forward-bts (bug)
2513   "Compose BTS forwarded control message to BTS."
2514   (tinydebian-bts-mail-type-macro
2515    nil nil nil
2516    (format "Debian Bug#%s -- forwarded upstream" bug)
2517    (insert
2518     (format "\
2519 forwarded %s <http://upstream.example.com/bug-tracking/nbr>
2520 thanks
2521
2522 "
2523             bug))))
2524
2525 ;;; ----------------------------------------------------------------------
2526 ;;;
2527 (defun tinydebian-bts-mail-ctrl-forward-main (bug &optional control-message)
2528   "Compose BTS control message: forward BUG report to upstream.
2529 If optional CONTROL-MESSAGE is non-nil, then compose regular BTS control
2530 message which can be used to record upstream's bug tracking system URL."
2531   (interactive
2532    (list (tinydebian-bts-mail-ask-bug-number)
2533          current-prefix-arg))
2534   (if control-message
2535       (tinydebian-bts-mail-ctrl-forward-bts bug)
2536     (tinydebian-bts-mail-ctrl-forward-upstream bug)))
2537
2538 ;;; ----------------------------------------------------------------------
2539 ;;;
2540 (defun tinydebian-bts-mail-message-info (bug &optional quiet)
2541   "Send more information to BUG, possibly with QUIET on.
2542 With QUIET,  the  email will only be archived, sent to package maintainer
2543 and not forwarded any Debian mailing lists."
2544   (interactive
2545    (list (tinydebian-bts-mail-ask-bug-number)
2546          current-prefix-arg))
2547   (let* ((email (tinydebian-bts-email-compose
2548                  (if quiet
2549                      (format "%s-maintonly" bug)
2550                    bug))))
2551     (tinydebian-bts-mail-type-macro
2552      nil nil email
2553      (format "Debian Bug#%s " bug))))
2554
2555 ;;}}}
2556 ;;{{{ Dpkg, apt functions
2557
2558 ;;; ----------------------------------------------------------------------
2559 ;;;
2560 (defun tinydebian-package-read-field-content-1 ()
2561   "Read content. Point must be positionioned at Field:-!-."
2562   (let* ((str (if (looking-at " +\\(.*\\)")
2563                   (match-string 1))))
2564     (while (and (not (eobp))
2565                 (zerop (forward-line 1)) ;; Did it
2566                 (looking-at "^\\( +.*\\)"))
2567       (setq str (concat (or str "") (match-string 1))))
2568     str))
2569
2570 ;;; ----------------------------------------------------------------------
2571 ;;;
2572 (defun tinydebian-package-read-field-content (&optional field)
2573   "Read FIELD forward. FIELD ust be name like `Package'.
2574 Be sure to call `tinydebian-package-narrow-to-region' first."
2575   (when (re-search-forward (format "^%s:" field) nil t)
2576     (tinydebian-package-read-field-content-1)))
2577
2578 ;;; ----------------------------------------------------------------------
2579 ;;;
2580 (defun tinydebian-package-parse-info-all ()
2581   "Parse all fields forward. Return '((field . info) (field . info) ..)."
2582   (let* (field
2583          alist)
2584     (while (re-search-forward "^\\([^ \t\r\n]+\\):" nil t)
2585       (setq field (match-string 1))
2586       (push (cons field (tinydebian-package-read-field-content-1))
2587             alist))
2588     (nreverse alist)))
2589
2590 ;;; ----------------------------------------------------------------------
2591 ;;;
2592 (defun tinydebian-package-info-from-buffer (buffer)
2593   "Parse dpkg -s from BUFFER. Buffer must contain nothing else."
2594   (with-current-buffer buffer
2595     (goto-char (point-min))
2596     (tinydebian-package-parse-info-all)))
2597
2598 ;;; ----------------------------------------------------------------------
2599 ;;;
2600 (defun tinydebian-package-status-parse-depends-1 ()
2601   "Parse `Depends' field content from current point forward.
2602 There must nothing else in the buffer."
2603   (let* (name
2604          op
2605          ver
2606          list)
2607     (while (re-search-forward "\\([a-z][^ ,()\t\r\n]+\\)" nil t)
2608       (setq name (ti::remove-properties (match-string 1))
2609             op   nil
2610             ver  nil)
2611       (cond
2612        ((looking-at " +(\\([=><]+\\) +\\([^ ,()\t\r\n]+\\))")
2613         (setq op   (ti::remove-properties (match-string 1))
2614               ver  (ti::remove-properties (match-string 2))))
2615        ((looking-at " *,?")))
2616       (goto-char (match-end 0))
2617       (push (list name op ver) list))
2618     (nreverse list)))
2619
2620 ;;; ----------------------------------------------------------------------
2621 ;;;
2622 (defun tinydebian-package-status-parse-depends (depends)
2623   "Parse `Depends' field from DEPENDS string.
2624 Example of the DEPENDS string:
2625
2626     \"libc6 (>= 2.2.4-2), cron (>= 3.0pl1-42)\"
2627
2628 Returned list is
2629
2630    '((\"libc6\" \">=\" \"2.2.4-2\")
2631      (\"cron\"  \">=\" \"3.0pl1-42\"))."
2632   (with-temp-buffer
2633     (insert depends)
2634     (ti::pmin)
2635     (tinydebian-package-status-parse-depends-1)))
2636
2637 ;;; ----------------------------------------------------------------------
2638 ;;;
2639 ;;; #todo:
2640 (defun tinydebian-package-status-apt-file (package)
2641   "Use apt-file PACKAGE (must be installed separately) to find upstream."
2642   (let* ((bin (executable-find "apt-file")))
2643     (cond
2644      ((null bin)
2645       (message "TinyDebian: no `apt-fil' found along PATH (emacs `exec-path').")
2646       (message "TinyDebian: Please run 'apt-get install apt-file'")
2647       nil)
2648      nil)))
2649
2650 ;;; ----------------------------------------------------------------------
2651 ;;;
2652 ;;; Package: autolog
2653 ;;; Status: install ok installed
2654 ;;; Priority: extra
2655 ;;; Section: admin
2656 ;;; Installed-Size: 45
2657 ;;; Maintainer: Nicolás Lichtmaier <nick@debian.org>
2658 ;;; Version: 0.35-10
2659 ;;; Depends: libc6 (>= 2.2.4-2), cron (>= 3.0pl1-42)
2660 ;;; Recommends: mail-transport-agent
2661 ;;; Conffiles:
2662 ;;;  /etc/autolog.conf a3fcae584ed74543a4a943e722593ff6
2663 ;;;  /etc/cron.d/autolog 805d268ea44c645299defc1c14495282
2664 ;;; Description: Terminates connections for idle users
2665 ;;;  Autolog terminates connections considered to be idle based on a large
2666 ;;;  variety of parameters.
2667 ;;;
2668 (defun tinydebian-package-status-dpkg-s (package)
2669   "Consult dpkg -s PACKAGE"
2670   (let* ((dpkg tinydebian-:bin-dpkg))
2671     (cond
2672      ((not dpkg)
2673       (message "TinyDebian: no `dpkg' found along PATH (emacs `exec-path').")
2674       nil)
2675      (t
2676       (with-temp-buffer
2677         (message "TinyDebian: Running ... dpkg -s %s" package)
2678         (tinydebian-call-process dpkg nil "-s" package)
2679         (ti::pmin)
2680         (when (re-search-forward "^Use dpkg" nil t)
2681           (message "TinyDebian: `dpkg`-s %s' returned error [%s]"
2682                    package
2683                    (buffer-string)))
2684         (tinydebian-package-parse-info-all))))))
2685
2686 ;;; ----------------------------------------------------------------------
2687 ;;; dpkg -S dh_make
2688 ;;;
2689 ;;; debhelper: /usr/bin/dh_makeshlibs
2690 ;;; dh-make: /usr/share/debhelper/dh_make/debian/postrm.ex
2691 ;;; dh-make: /usr/share/debhelper/dh_make/native
2692 ;;; dh-make: /usr/share/debhelper/dh_make/debian/changelog
2693 ;;; dh-make: /usr/share/debhelper/dh_make/debianl/shlibs.local.ex
2694 ;;; dh-make: /usr/share/man/man1/dh_make.1.gz
2695 ;;; dh-make: /usr/bin/dh_make
2696 ;;; dh-make: /usr/share/debhelper/dh_make/debiank/README.Debian
2697 ;;; dh-make: /usr/share/debhelper/dh_make/debianm/control
2698 ;;; dh-make: /usr/share/debhelper/dh_make/debian/init.d.ex
2699 ;;; dh-make: /usr/share/debhelper/dh_make/debian/cron.d.ex
2700 ;;; dh-make: /usr/share/debhelper/dh_make/debianm/rules
2701 ;;; dh-make: /usr/share/debhelper/dh_make/licenses/lgpl
2702 ;;; dh-make: /usr/share/debhelper/dh_make/debiank/control
2703 ;;; dh-make: /usr/share/debhelper/dh_make/debians/rules
2704 ;;; dh-make: /usr/share/debhelper/dh_make/debianl/package1.dirs
2705 ;;; dh-make: /usr/share/debhelper/dh_make/native/changelog
2706 ;;; dh-make: /usr/share/debhelper/dh_make/licenses/bsd
2707 ;;; dh-make: /usr/share/debhelper/dh_make/debianm/package-doc.files
2708 ;;; dh-make: /usr/share/debhelper/dh_make/debians/watch.ex
2709 ;;; dh-make: /usr/share/debhelper/dh_make/licenses/gpl
2710 ;;; dh-make: /usr/share/debhelper/dh_make/licenses/blank
2711 ;;;
2712 (defun tinydebian-package-status-dpkg-S-parse (package)
2713   "Examine dpkg -S PACKAGE listing and return package name."
2714   (ti::pmin)
2715   (when (re-search-forward (concat "^\\([^: \t\r\n]+\\):.*/"
2716                                    package
2717                                    "[ \t]*$")
2718                            nil t)
2719     (match-string 1)))
2720
2721 ;;; ----------------------------------------------------------------------
2722 ;;;
2723 (defun tinydebian-package-status-dpkg-S (file)
2724   "Consult dpkg -S FILE
2725 In this case, the package is unknown."
2726   (let* ((dpkg  tinydebian-:bin-dpkg))
2727     (cond
2728      ((not dpkg)
2729       (message "TinyDebian: no `dpkg' found along PATH (emacs `exec-path').")
2730       nil)
2731      (t
2732       (with-temp-buffer
2733         (message "TinyDebian: Running ... dpkg -S %s (takes a while)" file)
2734         (apply 'tinydebian-call-process dpkg nil (list "-S" file))
2735         (let ((pkg (tinydebian-package-status-dpkg-S-parse file)))
2736           (cond
2737            ((null pkg)
2738             (message
2739              "TinyDebian: dpkg -S doesn't know file `%s'" file)
2740             nil)
2741            (t
2742             (tinydebian-package-status-dpkg-s pkg)))))))))
2743
2744 ;;; ----------------------------------------------------------------------
2745 ;;;
2746 ;;;
2747 (defun tinydebian-package-status-apt-cache (package)
2748   "Consult dpkg -S FILE
2749 In this case, the package is unknown."
2750   (with-temp-buffer
2751     (message "TinyDebian: Running ... apt-cache show %s (takes a while)"
2752              package)
2753     (apply 'tinydebian-call-process "apt-cache" nil (list "show" package))
2754     (message "Done.")
2755     (unless (eq (point-max) (point-min))
2756       (goto-char (point-min))
2757       (tinydebian-package-parse-info-all))))
2758
2759 ;;; ----------------------------------------------------------------------
2760 ;;;
2761 ;;;
2762 (defun tinydebian-package-status-grep-available (package)
2763   "Consult grep-available(1) for PACKAGE from 'Provides' field."
2764   (let* ((bin tinydebian-:bin-grep-available)
2765          (re  (format ".*[ ,]+%s([, \t]|[ \t]*$)" package)))
2766     (cond
2767      ((not bin)
2768       (message (concat "TinyDebian: no `grep-available' "
2769                        "found along PATH (emacs `exec-path')."))
2770       nil)
2771      (t
2772       (with-temp-buffer
2773         (message "TinyDebian: Running ... grep-available -e %s" package)
2774         (apply 'tinydebian-call-process
2775                bin
2776                nil
2777                (list "--field=Provides"
2778                      "--eregex"
2779                      re))
2780         (let* ((info (tinydebian-package-info-from-buffer (current-buffer))))
2781           (cond
2782            ((null info)
2783             (message
2784              "TinyDebian: grep-available doesn't know package`%s'" package)
2785             nil)
2786            (t
2787             info))))))))
2788
2789 ;;; ----------------------------------------------------------------------
2790 ;;;
2791 (defun tinydebian-package-wnpp-main-interactive ()
2792   "Ask the type of request for WNPP package.
2793 References:
2794   `tinydebian-:menu-wnpp'
2795   `tinydebian-:menu-wnpp-selected'"
2796   (setq tinydebian-:menu-wnpp-selected nil)
2797   (ti::menu-menu 'tinydebian-:menu-wnpp)
2798   tinydebian-:menu-wnpp-selected)
2799
2800 ;;; ----------------------------------------------------------------------
2801 ;;;
2802 (defun tinydebian-buffer-ask-input (message buffer &optional clear)
2803   "Write MESSAGE to the buffer ans ask user to type input.
2804 The MESSAGE should contgain properly formatted text."
2805   (let* ((buffer (ti::temp-buffer buffer clear)))))
2806     ;; (switch-to-buffer buffer)
2807     ;; #todo:
2808
2809 ;;; ----------------------------------------------------------------------
2810 ;;;
2811 (defun tinydebian-package-wnpp-main (request-type)
2812   "Submit REQUEST-TYPE against WNPP pseudo package.
2813 WNPP is used for requesting to be a new Debian maintainer and
2814 for taking maintenance of other packages. Refer to
2815 http://www.debian.org/devel/wnpp and
2816 http://www.debian.org/doc/packaging-manuals/developers-reference/ch-pkgs.en.html
2817 and topic \"5.1 New Packages\"
2818
2819 REQUEST-TYPE can be symbol:
2820
2821   'package 'orphan 'adopt or 'new.
2822   See http://www.debian.org/devel/wnpp for more information
2823
2824 References:
2825
2826   `tinydebian-:menu-wnpp'."
2827   (interactive (list (tinydebian-package-wnpp-main-interactive)))
2828   (cond
2829    ((eq request-type 'package)
2830     (call-interactively 'tinydebian-bts-mail-type-itp))
2831    ((eq request-type 'new)
2832     (call-interactively 'tinydebian-bts-mail-type-rfp))
2833    ((eq request-type 'orphan)
2834     (call-interactively 'tinydebian-bts-mail-type-orphan))
2835    ((eq request-type 'adopt)
2836     (call-interactively 'tinydebian-bts-mail-type-ita))
2837    (t
2838     ;;  Nothing to do
2839     nil)))
2840
2841 ;;; ----------------------------------------------------------------------
2842 ;;;
2843 (defun tinydebian-package-status-main (package)
2844   "Find out PACKAGE details."
2845   (or (tinydebian-package-status-apt-cache package)
2846       (tinydebian-package-status-dpkg-s package)
2847       (tinydebian-package-status-grep-available package)
2848       (tinydebian-package-status-dpkg-S package)
2849       (tinydebian-package-status-apt-file package)
2850       (if (string-match "^wnpp" package)
2851           (error (concat "TinyDebian: package WNPP is special. "
2852                          "Use tinydebian-package-wnpp-main instead.")))
2853       (error "Tinydebian: Can't find package information. `%s'" package)))
2854
2855 ;;; ----------------------------------------------------------------------
2856 ;;;
2857 (defun tinydebian-package-info (&optional package prompt)
2858   "Get PACKAGE information. See`tinydebian-package-status'.
2859 If PACKAGE is nil and `tinydebian-:bin-dpkg' is not available,
2860 ask with PROMPT."
2861   (let* ((dpkg  tinydebian-:bin-dpkg))
2862     (or package
2863         (setq package (read-string
2864                        (or prompt
2865                            "[TinyDebian] Package name: "))))
2866     (or (and dpkg
2867              (tinydebian-package-status-main package)))))
2868         ;; FIXME: todo
2869
2870 ;;}}}
2871 ;;{{{ Bug reporting interface
2872
2873 ;;; ----------------------------------------------------------------------
2874 ;;;
2875 (defun tinydebian-bug-system-info-general ()
2876   "Return relevant system information."
2877   ;; FIXME: todo
2878   (interactive))
2879
2880 ;;; ----------------------------------------------------------------------
2881 ;;;
2882 (defun tinydebian-bug-system-info-depends (info &optional depend-key)
2883   "Return additional Dependency INFO from item `Depends'.
2884 DEPEND-KEY can be \"Depends\" or \"Pre-Depends\".
2885
2886 Example:
2887
2888   Versions of packages autolog depends on:
2889   ii  cron            3.0pl1-72  management of regular background p
2890   ii  libc6           2.2.5-3    GNU C Library: Shared libraries an."
2891   (let* ((depends (cdr-safe (and info
2892                                  (assoc
2893                                   (or depend-key "Depends")
2894                                   info))))
2895          str)
2896     (when depends
2897       (setq str "")
2898       (dolist (dep-info
2899                (tinydebian-package-status-parse-depends depends))
2900         (multiple-value-bind (package op version)
2901             dep-info
2902           ;; Not used yet, quiet byte compiler
2903           (if op
2904               (setq op op))
2905           (if version
2906               (setq version version))
2907           (let* (info2
2908                  desc
2909                  ver)
2910             (setq info2
2911                   (tinydebian-package-info
2912                    package
2913                    (format "\
2914 \[TinyDebian] Depend. Insert `dpkg -s %s' to *scratch* and press RET: "
2915                            package)))
2916             (setq ver  (cdr-safe (assoc "Version" info2)))
2917             ;; cut first few characters
2918             (when (setq desc (cdr-safe (assoc "Description" info2)))
2919               (setq desc (ti::string-left desc 45)))
2920             (setq str
2921                   (concat
2922                    str
2923                    (format "%-15s %-15s %s\n" package ver desc)))))))
2924     str))
2925
2926 ;;; ----------------------------------------------------------------------
2927 ;;;
2928 (defun tinydebian-bug-system-info-os-architecture ()
2929   "Read architecture."
2930   (if (not tinydebian-:bin-dpkg)
2931       ""
2932     (with-temp-buffer
2933       (tinydebian-call-process
2934        tinydebian-:bin-dpkg  nil "--print-installation-architecture")
2935       (tinydebian-string-delete-newlines
2936        (buffer-string)))))
2937
2938 ;;; ----------------------------------------------------------------------
2939 ;;;
2940 (defun tinydebian-bug-system-info-os-version ()
2941   "Read Debian version number."
2942   (let* ((file  "/etc/debian_version")
2943          (ret    (format "%s not found or readable." file)))
2944     (when (and (file-exists-p   file)
2945                (file-readable-p file))
2946       (with-temp-buffer
2947         (insert-file-contents-literally file)
2948         (setq ret
2949               (tinydebian-string-delete-newlines
2950                (buffer-string)))))
2951     ret))
2952
2953 ;;; ----------------------------------------------------------------------
2954 ;;;
2955 (defun tinydebian-bug-system-info-locale ()
2956   "Get locale information."
2957   (let* ((list
2958           '("LC_ALL"
2959             "LC_CTYPE"))
2960          val
2961          ret)
2962     (dolist (var list)
2963       (when (setq val (getenv var))
2964         (setq val (format "%s=%s" var val))
2965         (setq ret (if (null ret)
2966                       val
2967                     (concat ret ", " val)))))
2968     ret))
2969
2970 ;;; ----------------------------------------------------------------------
2971 ;;;
2972 (defun tinydebian-bug-system-info-os ()
2973   "Return OS information.
2974 Debian Release: 3.0
2975 Architecture: i386
2976 Kernel: Linux terra 2.4.17 #1 Fri Feb 8 21:32:43 EET 2002 i686
2977 Locale: LANG=en_US, LC_CTYPE=en_US."
2978   (let* ((kernel       (tinydebian-string-delete-newlines
2979                         (ti::process-uname)))
2980          (architecture (tinydebian-bug-system-info-os-architecture))
2981          (release      (tinydebian-bug-system-info-os-version))
2982          (locale       (tinydebian-bug-system-info-locale)))
2983     (format "\
2984 Debian Release: %s
2985 Architecture: %s
2986 Kernel: %s
2987 Locale: %s"
2988             release
2989             architecture
2990             kernel
2991             locale)))
2992
2993 ;;; ----------------------------------------------------------------------
2994 ;;;
2995 (defun tinydebian-bug-severity ()
2996   "Select bug severity."
2997   (setq tinydebian-:severity-selected nil)
2998   (while (null tinydebian-:severity-selected)
2999     (ti::menu-menu 'tinydebian-:menu-severity)
3000     (unless tinydebian-:severity-selected
3001       (message "TinyDebian: Please select severity.")
3002       (sit-for 1)))
3003   tinydebian-:severity-selected)
3004
3005 ;;; ----------------------------------------------------------------------
3006 ;;;
3007 (defun tinydebian-bug-report-mail-insert-details (info)
3008   "Insert Details for apckage INFO into Mail."
3009   (ti::mail-text-start 'move)
3010   (insert "Package: " (cdr (assoc "Package" info)) "\n")
3011   (insert "Version: " (cdr (assoc "Version" info)) "\n")
3012   (insert "Severity: " (tinydebian-bug-severity)   "\n\n")
3013   (let* ((point       (point))
3014          (depends     (tinydebian-bug-system-info-depends info "Depends"))
3015          (pre-depends (tinydebian-bug-system-info-depends info "Pre-Depends"))
3016          (package     (or (and info
3017                                (cdr (assoc "Package" info)))
3018                           (error "No package information."))))
3019     (insert "\n\n-- System Information\n"
3020             (tinydebian-bug-system-info-os)
3021             (format "\n\n-- Versions of packages `%s depends on'.\n"
3022                     package)
3023             (if pre-depends
3024                 (concat "Pre-Depends:\n" pre-depends)
3025               "")
3026             (if depends
3027                 (concat "Depends:\n" depends)
3028               ""))
3029     (goto-char point)))
3030
3031 ;;; ----------------------------------------------------------------------
3032 ;;;
3033 ;;;###autoload
3034 (defun tinydebian-bug-report-mail (info)
3035   "Submit Debian bug report. INFO is alist of attributes for package.
3036 An example ´reportbug(1)' looks like
3037
3038 To: submit@bugs.debian.org
3039 Subject: autolog ....
3040 --text follows this line--
3041 Package: autolog
3042 Version: 0.35-10
3043 Severity: wishlist
3044
3045 -- System Information
3046 Debian Release: 3.0
3047 Architecture: i386
3048 Kernel: Linux foo 2.4.17 #1 Fri Feb 8 21:32:43 EET 2002 i686
3049 Locale: LANG=en_US, LC_CTYPE=en_US
3050
3051 Versions of packages autolog depends on:
3052 ii  cron                          3.0pl1-72  management of regular background p
3053 ii  libc6                         2.2.5-3    GNU C Library: Shared libraries an
3054
3055 Subject: autolog based on DNS and IP names
3056 Package: autolog
3057 Version: 0.35-10
3058 Severity: wishlist
3059
3060 -- System Information
3061 Debian Release: 3.0
3062 Architecture: i386
3063 Kernel: Linux terra 2.4.17 #1 Fri Feb 8 21:32:43 EET 2002 i686
3064 Locale: LANG=en_US, LC_CTYPE=en_US
3065
3066 Versions of packages autolog depends on:
3067 ii  cron                          3.0pl1-72  management of regular background p
3068 ii  libc6                         2.2.5-3    GNU C Library: Shared libraries an."
3069   (interactive
3070    (progn
3071      (if (y-or-n-p "[TinyDebian] Submit bug report? ")
3072          (list (tinydebian-package-info))
3073        nil)))
3074   (let ((status  (or (cdr-safe (assoc "Status" info)) ""))
3075         (package (or (cdr-safe (assoc "Package" info)) "")))
3076     (cond
3077      ((null info)
3078       (message "TinyDebian: no INFO available to send a bug report."))
3079      ((string-match "not-installed" status)
3080       (message "TinyDebian: bug report skipped. ´%s' status is [%s]"
3081                package status))
3082      (t
3083       (let* ((name   (format "*mail* Debian Bug %s" package))
3084              buffer)
3085         (cond
3086          ((and (setq buffer (get-buffer name))
3087                (null (y-or-n-p
3088                       "[TinyDebian] delete previous bug report? ")))
3089           (pop-to-buffer buffer))
3090          (t
3091           (pop-to-buffer (get-buffer-create name))
3092           (erase-buffer)
3093           (let ((subject (read-string "[TinyDebian] bug Subject: ")))
3094             (mail-setup
3095              (tinydebian-bts-email-submit) subject nil nil nil nil))
3096           (message-mode)
3097           (tinydebian-bts-insert-headers)
3098           (tinydebian-bug-report-mail-insert-details info))))))))
3099
3100 ;;}}}
3101 ;;{{{ Admin functions: MAIL reports
3102
3103 ;;; ----------------------------------------------------------------------
3104 ;;;
3105 (defun tinydebian-command-audit-report-tiger-make-chmod (file line)
3106   "Make suotable chmod command for FILE according to LINE report."
3107   (let* ((operand "+")
3108          group
3109          group-cmd
3110          type
3111          type-cmd)
3112     (when (string-match
3113            "should .*+have +\\([^ \t\r\n]+\\) +\\([^ \t\r\n.]+\\)"
3114            line)
3115       (setq group (match-string 1 line)
3116             type  (match-string 2 line))
3117       (if (string-match "should not" line)
3118           (setq operand "-"))
3119       (cond
3120        ((string= group "group")
3121         (setq group-cmd "g"))
3122        ((string= group "world")
3123         (setq group-cmd "o")))
3124       (cond
3125        ((string-match type "read")
3126         (setq type-cmd "r"))
3127        ((string-match type "write")
3128         (setq type-cmd "w"))
3129        ((string-match type "exec")
3130         (setq type-cmd "x")))
3131       (when (and operand type-cmd group-cmd)
3132         (format "chmod %s%s%s %s;" group-cmd operand type-cmd file)))))
3133
3134 ;;; ----------------------------------------------------------------------
3135 ;;;
3136 (defun tinydebian-command-audit-report-tiger (beg end)
3137   "Process tiger(1) mail system report on region BEG END.
3138 The body of mail looks like:
3139
3140     # Performing check of system file permissions...
3141     OLD: --WARN-- [perm001w] /var/log/wtmp should not have group write.
3142     OLD: --WARN-- [perm001w] /var/run/utmp should not have group write.
3143     OLD: --WARN-- [perm001w] /var/log/XFree86.0.log should not have world read.
3144
3145 For which a corresponding command to correct the error is generated.
3146
3147     chmod g-w /var/log/wtmp;
3148     chmod g-w /var/run/utmp;
3149     chmod o-r /var/log/XFree86.0.log;
3150
3151 You can select region and these commands to shell `sh' with command
3152 `shell-command-on-region' which can be called with \\[shell-command-on-region]."
3153   (interactive "r")
3154   (let* ((buffer (get-buffer-create tinydebian-:buffer-tiger))
3155          done
3156          file
3157          str)
3158     (goto-char beg)
3159     (while (re-search-forward
3160             "--WARN-- +[^ \t\r\n]+ +\\(\\([^ \t\r\n]+\\).*\\)"
3161             nil end)
3162       (setq file (match-string 2)
3163             str  (match-string 1))
3164       (unless done                  ;Draw one empty line between calls
3165         (setq done t)
3166         (ti::append-to-buffer buffer "\n"))
3167       (when (setq str (tinydebian-command-audit-report-tiger-make-chmod
3168                        file str))
3169         (ti::append-to-buffer buffer (concat str "\n"))))
3170     (cond
3171      ((ti::buffer-empty-p buffer)
3172       (message
3173        "TinyDebian: Hm, region did not have --WARN-- chmod candidates."))
3174      (t
3175       (display-buffer buffer)
3176       (message
3177        (substitute-command-keys
3178         (concat
3179          "TinyDebian: [tiger] "
3180          "Select region and send commands to"
3181          " `sh' with \\[shell-command-on-region]")))))))
3182
3183 ;;}}}
3184
3185 (tinydebian-install-severity-functions) ;; Auto-created functions
3186
3187 (add-hook 'tinydebian-:bts-mode-define-keys-hook
3188           'tinydebian-bts-mode-define-keys)
3189
3190 (defalias 'tinydebian-reportbug 'tinydebian-bug-report-mail)
3191
3192 (provide   'tinydebian)
3193 (run-hooks 'tinydebian-:load-hook)
3194
3195 ;;; tinydebian.el ends here