emacs_el/tiny-tools/tiny/tinycygwin.el

   1 ;;; tinycygwin.el --- Cygwin utilities (bug reports, administrative tasks).
   2
   3 ;;{{{ Id
   4
   5 ;; Copyright (C)    2004-2007 Jari Aalto
   6 ;; Keywords:        extensions
   7 ;; Author:          Jari Aalto
   8 ;; Maintainer:      Jari Aalto
   9 ;;
  10 ;; Look at the code with folding.el
  11
  12 ;; COPYRIGHT NOTICE
  13 ;;
  14 ;; This program is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by the Free
  16 ;; Software Foundation; either version 2 of the License, or (at your option)
  17 ;; any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  21 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  22 ;; for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with program; see the file COPYING. If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28 ;;
  29 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  30
  31 ;;}}}
  32 ;;{{{ Install
  33
  34 ;; ........................................................ &t-install ...
  35 ;;   Put this file on your Emacs-Lisp load path, add following into your
  36 ;;   $HOME/.emacs startup file
  37 ;;
  38 ;;   (add-hook 'tinycygwin-:load-hook 'tinycygwin-install)
  39 ;;   (autoload 'tinycygwin-reportbug "tinycygwin" nil t)
  40 ;;   (autoload 'tinycygwin-package-info-port-maintainer-list "tinycygwin" nil t)
  41 ;;
  42 ;;   To get extra cygwin bindings in `message-mode', add this
  43 ;;
  44 ;;   (add-hook 'tinycygwin-:load-hook 'tinycygwin-install-message-mode)
  45
  46 ;;}}}
  47 ;;{{{ Documentation
  48
  49 ;; ..................................................... &t-commentary ...
  50
  51 ;;; Commentary:
  52
  53 ;;  Overview of features
  54 ;;
  55 ;;      This package contains utilities for the Cygwin System.
  56 ;;      It will help users to submit bug reports from Emacs.
  57 ;;      Learn more about Cygwin at http://www.cygwin.org/
  58 ;;
  59 ;;      To report bug against Cygwin package:
  60 ;;
  61 ;;          M-x tinycygwin-reportbug
  62 ;;
  63 ;;      When reporting bugs, one pseudo package is available which
  64 ;;      does not actually exist. If you select package "bug-generic"
  65 ;;      a standard bug template is generated. It can be used to report e.g.
  66 ;;      a configuration problem or to send a patch proposal to a 3rd party.
  67 ;;      The template provides additional environemtn information on your
  68 ;;      current syste,
  69 ;;
  70 ;;      A bug report's Subject is set to a time based id tag to thelp
  71 ;;      tracking and monitoring the messages.
  72 ;;
  73 ;;      To display list of all packages and their maintainers:
  74 ;;
  75 ;;          M-x tinycygwin-package-info-port-maintainer-list
  76 ;;
  77 ;;      To include e.g. cygcheck results to Email buffer, call
  78 ;;
  79 ;;          M-x tinycygwin-sysinfo-insert-os-cygwin
  80 ;;
  81 ;;      Further reading:
  82 ;;
  83 ;;          http://cygwin.com/problems.html
  84
  85 ;;}}}
  86
  87 ;;; Change Log:
  88
  89 ;;; Code:
  90
  91 ;;{{{ setup: libraries
  92
  93 (eval-when-compile
  94   (require 'cl))
  95
  96 (eval-and-compile
  97   ;;  Forward declarations
  98   (autoload 'executable-find            "executable")
  99   (autoload 'mail-setup                 "sendmail")
 100   (autoload 'message-mode               "message")
 101   (autoload 'message-disassociate-draft "message")
 102   (autoload 'message-fetch-field        "message")
 103   (autoload 'message-goto-cc            "message")
 104   (autoload 'ti::menu-menu              "tinylibmenu")
 105   (autoload 'mml-attach-file            "mml")
 106   (autoload 'mml-minibuffer-read-type   "mml")
 107   (autoload 'base64-decode-string       "base64")
 108   ;;  Byte compiler silencer. Defined in separate file
 109   (defvar debug-ignored-errors)
 110   (defvar font-lock-defaults)
 111   (defvar font-lock-keyword-face)
 112   (defvar font-lock-keywords)
 113   (defvar font-lock-mode)
 114   (defvar global-font-lock-mode)
 115   (defvar gnus-agent-send-mail-function)
 116   (defvar mail-header-separator)
 117   (defvar message-font-lock-keywords)
 118   (defvar message-mode-map)
 119   (defvar message-send-actions)
 120   (defvar message-user-mail-address)
 121   (defvar smtpmail-debug-info)
 122   (defvar smtpmail-local-domain)
 123   (defvar stack-trace-on-error)
 124   (defvar tinycygwin-:command-switch-email)
 125   (defvar tinycygwin-:command-switch-expert)
 126   (defvar tinycygwin-:command-switch-files)
 127   (defvar tinycygwin-:command-switch-package)
 128   (defvar tinycygwin-:command-switch-type)
 129   (defvar user-mail-address)
 130   (defvar window-system))
 131
 132 (defgroup dired nil
 133   "Cygwin System administrator's grabbag of utilities."
 134   :group 'TinyCygwin)
 135
 136 ;;}}}
 137 ;;{{{ setup: hooks
 138
 139 ;;; ......................................................... &v-hooks ...
 140
 141 (defcustom tinycygwin-:load-hook nil
 142   "*Hook run when file has been loaded."
 143   :type  'hook
 144   :group 'TinyCygwin)
 145
 146 (defcustom tinycygwin-:bug-report-mail-hook nil
 147   "*Hook run after `tinycygwin-bug-report-mail-compose-interactive'."
 148   :type  'hook
 149   :group 'TinyCygwin)
 150
 151 ;;}}}
 152 ;;{{{ setup: user config
 153
 154 ;;; ................................................... &v-user-config ...
 155
 156 (defcustom tinycygwin-:dummy nil
 157   "*"
 158   :type  'string
 159   :group 'TinyCygwin)
 160
 161 (defface tinycygwin-:warn-face
 162   '((((class color) (background light))
 163      (:background "green"))
 164     (((class color) (background dark))
 165      (:background "sea green"))
 166     (((class grayscale monochrome)
 167       (background light))
 168      (:background "black"))
 169     (((class grayscale monochrome)
 170       (background dark))
 171      (:background "white")))
 172   "Face used for warnings."
 173   :group 'TinyCygwin)
 174
 175 (defface tinycygwin-:item-face
 176   '((((class color) (background light))
 177      (:foreground "green4"))
 178     (((class color) (background dark))
 179      (:foreground "green3")))
 180   "Face used for noticing important items."
 181   :group 'TinyCygwin)
 182
 183 (defcustom tinycygwin-:expert-flag nil
 184   "*If non-nin, ask minimum of question in expert mode.
 185 All fancy features or Emacs settings are also disabled."
 186   :type 'boolean)
 187
 188 (defcustom tinycygwin-:debug nil
 189   "*Print extra message when debug iqs non-nil."
 190   :type 'boolean)
 191
 192 ;;}}}
 193 ;;{{{ setup: -- private
 194
 195 ;;; ....................................................... &v-private ...
 196
 197 (defvar tinycygwin-:os-type
 198   (cond
 199    ;;  Win32 and Cygwin are considered equal here
 200    ((or (memq system-type '(ms-dos windows-nt))
 201         (file-directory-p "c:/"))
 202     'cygwin)
 203    ((or (memq system-type '(gnu/linux))
 204         (string-match "linux" (emacs-version))
 205         (file-directory-p "/boot/vmlinuz")
 206         (file-directory-p "/vmlinuz"))
 207     'linux)
 208    ((or (memq system-type '(darwin))
 209         (string-match "darwin" (emacs-version))) ;; Mac OS
 210     'darwin))
 211   "Recognized system type: cygwin, linux, darwin,")
 212
 213 (defvar tinycygwin-:original-font-lock-keywords nil
 214   "This value holds copy of `font-lock-keywords'. Do not touch.
 215 Variable is made buffer local in `message-mode'.")
 216
 217 (defvar tinycygwin-:external-call-flag nil
 218   "Set to non-nil while bug interface is called form external shell script.
 219 Do not in any circumstances set this variable.")
 220
 221 (defvar tinycygwin-:external-call-flag-value nil
 222   "Set to non-nil while bug interface is called form external shell script.
 223 This is buffer local version of dynamically bound
 224 `tinycygwin-:external-call-flag'.")
 225
 226 (defvar tinycygwin-:external-email-address nil
 227   "Set to non-nil when bug interface is called form external shell script.
 228 Do not in any circumstances set this variable, but
 229 set `user-mail-address' to correct value.")
 230
 231 (defvar tinycygwin-:email-cygwin-users-list
 232   "user list <cygwin@cygwin.com>"
 233   "Email address of Cygwiin mailing list.")
 234
 235 (defvar tinycygwin-:email-cygwin-apps-list
 236   "devel list (subscriber only) <cygwin-apps@cygwin.com>"
 237   "Email address of Cygwin mailing list.")
 238
 239 (defvar tinycygwin-:email-cygwin-xfree-list
 240   "xfree devel list <cygwin-apps@cygwin.com>"
 241   "Email address of Cygwiin mailing list.")
 242
 243 (defvar tinycygwin-:email-cygbug-maintainer
 244   (lambda ()
 245     (concat
 246      "cygbug/tinycygwin.el maintainer - "
 247      (base64-decode-string "amFyaS5hYWx0b0Bwb2JveGVzLmNvbQ==")))
 248   "Email address of mainteiner. String or function.
 249 The function should return email address.")
 250
 251 (defvar tinycygwin-:root-dir "/"
 252   "Location of Cygwin root directory.")
 253
 254 (defvar tinycygwin-:file-install-db
 255   (concat (file-name-as-directory tinycygwin-:root-dir)
 256           "etc/setup/installed.db")
 257   "Location of `installed.db'.
 258 Notice that this is the official Cygwin nstallation file that
 259 reports packages that have been installed using Cygwin netinstaller.
 260 This does not report any 3rd party local installation.")
 261
 262 (defvar tinycygwin-:path-doc-root-list
 263   (list (concat (file-name-as-directory tinycygwin-:root-dir)
 264                 "usr/share/doc")
 265         (concat (file-name-as-directory tinycygwin-:root-dir)
 266                 "usr/doc")) ;; Old location
 267   "Location of documentation.")
 268
 269 (defvar tinycygwin-:path-doc-cygwin-list
 270   (list (concat (file-name-as-directory tinycygwin-:root-dir)
 271                 "usr/share/doc/Cygwin")
 272         (concat (file-name-as-directory tinycygwin-:root-dir)
 273                 "usr/doc/Cygwin")) ;; Old location
 274   "List of directories of Cygwin package documentation.")
 275
 276 (defvar tinycygwin-:bin-cygcheck (executable-find "cygcheck")
 277   "Location of `cygcheck' binary.")
 278
 279 (defvar tinycygwin-:file-cygcheck
 280   (concat (file-name-as-directory tinycygwin-:root-dir)
 281           "tmp/cygcheck-report.txt")
 282   "Cached result of cygcheck -c -s -d")
 283
 284 (defvar tinycygwin-:buffer-maintainer-list "*Cygwin maintainer summary*"
 285   "List of Cygwin packages and their maintainers.
 286 See \\[tinycygwin-package-info-port-maintainer-list\\]")
 287
 288 (defvar tinycygwin-:buffer-cygcheck "*Cygwin cygcheck*"
 289   "Cygcheck systeinfo buffer")
 290
 291 (defvar tinycygwin-:history-ask-program nil
 292   "History of quesions.
 293 See function `tinycygwin-message-mode-attach-program-version'.")
 294
 295 (defvar tinycygwin-:history-ask-version nil
 296   "History of quesions.
 297 See function `tinycygwin-message-mode-attach-program-version'.")
 298
 299 (defconst tinycygwin-:sysinfo-program-list
 300   '((devel-tools ("gcc" "make" "libtool" "automake"))
 301     (lang        ("perl" "python" "ruby")))
 302   "List of system information bundles.
 303 Format:
 304
 305   '((BUNDLE-SYMBOL (\"program\" \"program\" ...))
 306     ..)")
 307
 308 (defconst tinycygwin-:sysinfo-environment-list
 309   '("CYGWIN")
 310   "List of environment variables to include to bug report.")
 311
 312 (defvar tinycygwin-:package-maintainer-email-include nil
 313   "Should the Cygwin Net package maintainer's email addres be offered.
 314 Nil is the default value. If you set this to `t' be sure that
 315 you know what you're doing. The default policy is not to send any personal
 316 mail, but direct bug messages to the mailing lists.
 317
 318 Only if you're a package developer and know some of the maintainers
 319 personally, setting this variable to t provide concatct help.")
 320
 321 (defvar tinycygwin-:package-upstream-email-include t
 322   "Should the Upstream author's email address be offered.
 323 That, the author who is developing the package. Most likely he knows
 324 nothing about Cygwin, so tthe Cygwin mailing lists should be the
 325 first contact points. If you have found real bug, then it would
 326 be good to contact the Author.")
 327
 328 ;;  Same as in Debian
 329 (defconst tinycygwin-:severity-list
 330   '(("critical"
 331      "Makes unrelated software on the system (or the whole system) break,
 332 or causes serious data loss, or introduces a security hole on systems where
 333 you install the package.")
 334     ("grave"
 335      "Makes the package in question unuseable or mostly so, or causes data
 336 loss, or introduces a security hole allowing access to the accounts of users
 337 who use the package.")
 338     ("serious"
 339      "Severe violation of policy (that is, it violates a
 340 \"must\" or \"required\" directive), or, in the package maintainer's
 341 opinion, makes the package unsuitable for release.")
 342     ("important"
 343      "A bug which has a major effect on the usability of a package,
 344 without rendering it completely unusable to everyone.")
 345     ("normal"
 346      "The default value, applicable to most bugs.")
 347     ("minor"
 348      "A problem which doesn't affect the package's usefulness, and is
 349 presumably trivial to fix.")
 350     ("wishlist"
 351      "For any feature request, and also for any bugs that are very
 352 difficult to fix due to major design considerations.")
 353     ("fixed"
 354      "For bugs that are fixed but should not yet be closed. This is an
 355 exception for bugs fixed by non-maintainer uploads. Note: the "fixed"
 356 tag should be used instead."))
 357   "The bug system may record a severity level with each bug report.
 358 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.")
 359
 360 (defvar tinycygwin-:menu-severity-selected nil
 361   "Functions `tinycygwin-severity-select-*' set this to user selection.")
 362
 363 (defvar tinycygwin-:menu-bug-classification-selected nil
 364   "Functions `tinycygwin-type-select-*' set this to user selection.")
 365
 366 (defconst tinycygwin-:menu-bug-classification
 367   '("\
 368 Type of bug: q)uit ?)help RET)standard u)pdate U)pstream"
 369     ;; NOTE: These function are automatically created, you don't find
 370     ;; See `tinycygwin-install-bug-classification-functions'.
 371     ((?\C-m .   ( (setq tinycygwin-:menu-bug-classification-selected
 372                         "standard")))
 373      (?u .      ( (setq tinycygwin-:menu-bug-classification-selected
 374                         "update")))
 375      (?U .      ( (setq tinycygwin-:menu-bug-classification-selected
 376                         "upstream")))))
 377   "Bug classification menu.
 378
 379 standard
 380     Report standard package bug. The packaging is erroneous, files are
 381     in incorrect places, configuration files have problems, default setup
 382     does not work etc.
 383
 384     Please do not report program's behavious problems. The package
 385     maintainer does not know how the program is supposed to work. He has
 386     only put it available in Cygwin Net Release form, so he is not the
 387     correct person where to report problems in the program itself (see
 388     bug type 'upstream' below).
 389
 390 update
 391     Request package update. Package included in Cygwin is out of date
 392     and there is newer one available at upstream sources. You want the
 393     package maintainer to be informed.
 394
 395 upstream
 396     Report problems to upstream. You are seing erratic behavior of the
 397     program or you think some new feature would be nice. Contact maintainer
 398     or author of the program.")
 399
 400 (defconst tinycygwin-:menu-severity
 401   '("\
 402 Severity: q?)help c)rit g)rave s)erious i)import RET-n)orm m)inor w)ish f)ixed"
 403     ;; NOTE: These function are automatically created, you don't find
 404     ;; them with C-h f or from this file with C-s.
 405     ;; See `tinycygwin-install-severity-functions'
 406     ((?c .      ( (call-interactively 'tinycygwin-severity-select-critical)))
 407      (?g .      ( (call-interactively 'tinycygwin-severity-select-grave)))
 408      (?s .      ( (call-interactively 'tinycygwin-severity-select-serious)))
 409      (?i .      ( (call-interactively 'tinycygwin-severity-select-important)))
 410      (?n .      ( (call-interactively 'tinycygwin-severity-select-normal)))
 411      (?\C-m .   ( (call-interactively 'tinycygwin-severity-select-normal)))
 412      (?m .      ( (call-interactively 'tinycygwin-severity-select-minor)))
 413      (?w .      ( (call-interactively 'tinycygwin-severity-select-wishlist)))
 414      (?f .      ( (call-interactively 'tinycygwin-severity-select-fixed)))))
 415   "Severity menu.
 416
 417 The bug system records a severity level with each bug report. This is set
 418 to normal by default, but can be overridden either by supplying a Severity
 419 line in the pseudo-header when the bug is submitted (see the instructions
 420 for reporting bugs), or by using the severity command with the control
 421 request server.
 422
 423 critical
 424     Makes unrelated software on the system (or the whole system) break, or
 425     causes serious data loss, or introduces a security hole on systems where
 426     you install the package.
 427
 428 grave
 429     Makes the package in question unuseable or mostly so, or causes data loss,
 430     or introduces a security hole allowing access to the accounts of users who
 431     use the package.
 432
 433 serious
 434     Is a severe violation of policy (that is, it violates a \"must\" or
 435     \"required\" directive), or, in the package maintainer's opinion, makes the
 436     package unsuitable for release.
 437
 438 important
 439     A bug which has a major effect on the usability of a package, without
 440     rendering it completely unusable to everyone.
 441
 442 normal
 443     The default value, applicable to most bugs.
 444
 445 minor
 446     A problem which doesn't affect the package's usefulness, and is presumably
 447     trivial to fix.
 448
 449 wishlist
 450     For any feature request, and also for any bugs that are very difficult to
 451     fix due to major design considerations.
 452
 453 fixed
 454     For bugs that are fixed but should not yet be closed. This is an exception
 455     for bugs fixed by non-maintainer uploads. Note: the \"fixed\" tag should be
 456     used instead.  Certain severities are considered release-critical, meaning
 457     the bug will have an impact on releasing the package with the stable
 458     release. Currently, these are critical, grave and serious.")
 459
 460 (defvar tinycygwin-:tags-list
 461   '(("patch"
 462      "A patch or some other easy procedure for fixing the bug is included
 463 in the bug logs. If there's a patch, but it doesn't resolve the bug
 464 adequately or causes some other problems, this tag should not be used.")
 465     ("wontfix"
 466      "This bug won't be fixed. Possibly because this is a choice between
 467 two arbitrary ways of doing things and the maintainer and submitter prefer
 468 different ways of doing things, possibly because changing the behaviour
 469 will cause other, worse, problems for others, or possibly for other reasons.")
 470     ("moreinfo"
 471      "This bug can't be addressed until more information is provided by
 472 the submitter. The bug will be closed if the submitter doesn't provide
 473 more information in a reasonable (few months) timeframe. This is for
 474 bugs like "It doesn't work". What doesn't work?.")
 475     ("unreproducible"
 476      "This bug can't be reproduced on the maintainer's system.
 477 Assistance from third parties is needed in diagnosing the cause of the problem.")
 478     ("help"
 479      "The maintainer is requesting help with dealing with this bug.")
 480     ("pending"
 481      "The problem described in the bug is being actively worked on,
 482 i.e. a solution is pending.")
 483     ("fixed"
 484      "This bug is fixed or worked around (by a non-maintainer upload,
 485 for example), but there's still an issue that needs to be resolved.
 486 This tag replaces the old \"fixed\" severity.")
 487     ("security"
 488      "This bug describes a security problem in a package (e.g., bad
 489 permissions allowing access to data that shouldn't be accessible;
 490 buffer overruns allowing people to control a system in ways they
 491 shouldn't be able to; denial of service attacks that should be fixed, etc).
 492 Most security bugs should also be set at critical or grave severity.")
 493     ("upstream"
 494      "This bug applies to the upstream part of the package."))
 495   "Each bug can have zero or more of a set of given tags.
 496 These tags are displayed in the list of bugs when you look at a
 497 package's page, and when you look at the full bug log.")
 498
 499 (defvar tinycygwin-:wnpp-buffer "*TinyCygwin WNPP*"
 500   "WNPP question buffer.")
 501
 502 (defvar tinycygwin-:menu-wnpp-selected nil
 503   "Placeholder of selection from `tinycygwin-:menu-wnpp'.")
 504
 505 (defconst tinycygwin-:menu-wnpp
 506   (list
 507    '(format
 508      "\
 509 WNPP:%s q?)help 1i)itp 2o)rphan 3a)dopt 4n)ew suggested package"
 510      (if tinycygwin-:menu-wnpp-selected
 511          (format "%s; " (symbol-name tinycygwin-:menu-wnpp-selected))
 512        ""))
 513    (list
 514     '(?1 . ( (setq tinycygwin-:menu-wnpp-selected 'package)))
 515     '(?i . ( (setq tinycygwin-:menu-wnpp-selected 'package)))
 516     '(?I . ( (setq tinycygwin-:menu-wnpp-selected 'package)))
 517     '(?p . ( (setq tinycygwin-:menu-wnpp-selected 'package)))
 518     '(?P . ( (setq tinycygwin-:menu-wnpp-selected 'package)))
 519     '(?2 . ( (setq tinycygwin-:menu-wnpp-selected 'orphan)))
 520     '(?o . ( (setq tinycygwin-:menu-wnpp-selected 'orphan)))
 521     '(?O . ( (setq tinycygwin-:menu-wnpp-selected 'orphan)))
 522     '(?3 . ( (setq tinycygwin-:menu-wnpp-selected 'adopt)))
 523     '(?a . ( (setq tinycygwin-:menu-wnpp-selected 'adopt)))
 524     '(?A . ( (setq tinycygwin-:menu-wnpp-selected 'adopt)))
 525     '(?4 . ( (setq tinycygwin-:menu-wnpp-selected 'new)))
 526     '(?n . ( (setq tinycygwin-:menu-wnpp-selected 'new)))
 527     '(?N . ( (setq tinycygwin-:menu-wnpp-selected 'new)))))
 528   ;;  This message is straight from reportbug(1)
 529   ;;  'apt-get install reportbug'
 530   "What request type? If none of these things mean anything to you you
 531 should report normal bug to existing package instead.
 532
 533 1 i    ITP, `Intent To Package'. You want to be maintainer
 534        of this package. Please submit a package description
 535        along with copyright and URL in such a report.
 536
 537 2 o    The package has been `Orphaned'. Nobody is maintaining it.
 538        It needs a new maintainer as soon as possible.
 539
 540 3 a    RFA, this is a `Request for Adoption'. Due to lack of time, resources,
 541        interest or something similar, the current maintainer is asking for
 542        someone else to maintain this package. He/she will maintain it in the
 543        meantime, but perhaps not in the best possible way. In short: the
 544        package needs a new maintainer.
 545
 546 4 n    RFP, this is a `Request For Package'. You have found an interesting
 547        piece of software and would like SOMEONE ELSE to package and
 548        maintain it. Please submit a package description along with
 549        copyright and URL in such a report.
 550
 551 q      Quit menu.
 552
 553 See http://www.debian.org/devel/wnpp for more information
 554 ")
 555
 556 ;; Emacs includes so good message.el colors, that it does not need
 557 ;; these. Do not modify.
 558
 559 (defvar tinycygwin-:message-mode-font-lock-keywords-window-system
 560   (list
 561    (list
 562     "^-- +[A-Z][^ \t\r\n]+ +.*"
 563     (list 0 'font-lock-builtin-face t))
 564    (list
 565     "^Severity:[ \t]+\\(critical\\|grave\\|serious\\)"
 566     (list 1 'font-lock-warning-face t))
 567    (list
 568     "^Severity:[ \t]+\\(wishlist\\)"
 569     (list 1 'font-lock-string-face t))
 570    (list
 571     "^[A-Z][^ \t\r\n]+:"
 572     (list 0 'font-lock-doc-string-face))
 573    (list
 574     "^\\[ATTACHMENT.*"
 575     (list 0 'font-lock-constant-face t)))
 576   "Additional `message-mode' `font-lock-keywords'.
 577 This is for XEmacs. Activated only if `tinycygwin-:expert-flag' is nil.")
 578
 579 ;;;   (list
 580 ;;;    "^\\([Tt]o:\\)\\(.*\\)"
 581 ;;;    (list 1 'message-header-name-face)
 582 ;;;    (list 2 'message-header-to-face nil t))
 583 ;;;   (list
 584 ;;;    "^\\([Cc]C\\|Reply-[Tt]o:\\)\\(.*\\)"
 585 ;;;    (list 1 'message-header-name-face)
 586 ;;;    (list 2 'message-header-cc-face nil t))
 587 ;;;   (list
 588 ;;;    "^\\(Subject:\\)\\(.*\\)"
 589 ;;;    (list 1 'message-header-name-face)
 590 ;;;    (list 2 'message-header-subject-face nil t))
 591
 592 (defvar tinycygwin-:message-mode-font-lock-keywords-non-window-system
 593   ;;  In XEmacs 21.4, Cygwin, there are only two faces available.
 594   (list
 595    (list
 596     "^[A-Z][^ \t\r\n]+:"
 597     (list 0 'font-lock-type-face))
 598    (list
 599     "^-- +[A-Z][^ \t\r\n]+ +.*"
 600     (list 0 'font-lock-function-name-face t))
 601    (list
 602     "^Severity:[ \t]+\\(critical\\|grave\\|serious\\)"
 603     (list 1 'font-lock-warning-face t))
 604    (list
 605     "^Severity:[ \t]+\\(wishlist\\)"
 606     (list 1 'font-lock-comment-face t))
 607    (list
 608     "^\\[ATTACHMENT.*"
 609     (list 0 'message-header-other-face t)))
 610   "Additional `message-mode' `font-lock-keywords'.
 611 This is for XEmacs. Activated only if `tinycygwin-:expert-flag' is nil.")
 612
 613 (defvar tinycygwin-:email-address-correct-list
 614   '((" A *T " "@")
 615     (" do?t " "."))
 616   "List of regexp to correct email addresses.
 617 Format:
 618   '((SEARCH-REGEXP  REPLACE-STRING)
 619     (SEARCH-8REGEXP REPLACE-STRING)
 620      ...)")
 621
 622 ;;}}}
 623 ;;{{{ XEmacs support
 624
 625 ;;; ----------------------------------------------------------------------
 626 ;;;
 627 ;;; (put 'tinycygwin-defalias 'lisp-indent-function 0)
 628 (defmacro tinycygwin-defalias (this that)
 629   "If there is no THIS then use THAT. Signal error if cannot make `defalias'."
 630   `(if (not (fboundp ,this))
 631        (if (fboundp ,that)
 632            (defalias ,this ,that)
 633          (error "[ERROR] function is not supported by this X/Emacs: %s"
 634                 (symbol-name ,this)))))
 635
 636 (unless (fboundp 'replace-regexp-in-string)
 637   (defun replace-regexp-in-string (re str string)
 638     "TinyCygwin XEmacs support.
 639 This is a cheap implementaion of an Emacs function and it DOES NOT
 640 support all the capabilities. You code will break if it relies on this
 641 to exist."
 642     (with-temp-buffer
 643       (insert string)
 644       (goto-char (point-min))
 645       (while (re-search-forward re nil t)
 646         (replace-match str))
 647       (buffer-string))))
 648
 649 (defun tinycygwin-window-system ()
 650   "XEmacs and Emacs Compatibility, Mimic Emacs `window-system' variable.
 651 In XEmacs the `cosole-type' returns 'tty on terminal, but this function
 652 return nil to be in par with Emacs behavior. An 'tty is not a windowed
 653 environment."
 654   (let ((func 'console-type))
 655     (cond
 656      ((fboundp func)
 657       (let ((val (funcall func)))
 658         (unless (eq 'tty val)
 659           val)))
 660      ((boundp 'window-system)
 661       (symbol-value 'window-system)))))
 662
 663 (tinycygwin-defalias 'insert-file-literally   'insert-file-contents-literally)
 664 (tinycygwin-defalias 'insert-file-literally   'insert-file)
 665 (tinycygwin-defalias 'line-beginning-position 'point-at-bol)
 666 (tinycygwin-defalias 'line-end-position       'point-at-eol)
 667
 668 ;;}}}
 669 ;;{{{ General
 670
 671 ;;; ----------------------------------------------------------------------
 672 ;;;
 673 (defsubst tinycygwin-file-binary-p (file)
 674   "Check if FILE name looks like binary file (.gz etc.)."
 675   (string-match "\\.\\(g?z\\|bz2\\|zip\\|tar\\)" file))
 676
 677 ;;; ----------------------------------------------------------------------
 678 ;;;
 679 (defun tinycygwin-insert-file (file)
 680   "INsert FILE literally at point."
 681   (tinycygwin-clean-system-with
 682    (insert-file-literally file)))
 683
 684 ;;; ----------------------------------------------------------------------
 685 ;;;
 686 (defsubst tinycygwin-mail-attachment-tag (string)
 687   "Return attachment tag for STRING."
 688   (format "[ATTACHMENT: %s]"
 689           (if (string-match "[\\/]" string)
 690               (file-name-nondirectory string)
 691             string)))
 692
 693 ;;; ----------------------------------------------------------------------
 694 ;;;
 695 (defsubst tinycygwin-maintainer ()
 696   "Return maintainer."
 697   (let ((val tinycygwin-:email-cygbug-maintainer))
 698     (cond
 699      ((functionp val)
 700       (funcall val))
 701      ((stringp val)
 702       val)
 703      ((listp val)
 704       (eval val)))))
 705
 706 ;;; ----------------------------------------------------------------------
 707 ;;;
 708 (defun tinycygwin-variable-documentation (variable-sym)
 709   "Return documentation of VARIABLE-SYM."
 710   (let ((str (documentation-property
 711               (if (boundp variable-sym)
 712                   variable-sym)
 713               'variable-documentation)))
 714     (when (stringp str)
 715       (replace-regexp-in-string
 716        "\r" ;; Remove possible extra line endings
 717        ""
 718        str))))
 719
 720 ;;}}}
 721 ;;{{{ Install: bindings
 722
 723 ;;; ........................................................ &bindings ...
 724
 725 (defun  tinycygwin-tab-to-tab-stop-4-spaces (map)
 726   "Define TAB key to run 4 spaces."
 727   ;;  Status:     `tab-stop-list' is core Emacs variable
 728   ;;  Info:       (Info-goto-node "(emacs)Tab Stops")
 729   ;;
 730   ;;  Make TAB key advance at 4 positions at the time. The code
 731   ;;  will set the tab-stop-list to value '(4 8 12 16 20 ...)
 732   (make-local-variable 'tab-stop-list)
 733   (setq tab-stop-list
 734         (let ((i 4) list)
 735           (while (< i 80)
 736             (setq list (cons i list))
 737             (setq i (+ i 4)))
 738           (reverse list)))
 739   (define-key map "\t" 'tab-to-tab-stop))
 740
 741 ;; #todo:
 742 (defun tinycygwin-bug-report-default-bindings ()
 743   "Define default key bindings to `tinycygwin-mode-map'.")
 744
 745 ;;}}}
 746 ;;{{{ Install: generate severity function etc.
 747
 748 ;;; ----------------------------------------------------------------------
 749 ;;;
 750 (put 'tinycygwin-install-menu-function-macro 'lisp-indent-function 0)
 751 (defmacro tinycygwin-install-menu-function-macro (template value variable)
 752   "Generate ti::menu TEMPLATE, VALUE using VARIABLE."
 753   (let* ((sym (intern (format template value))))
 754     `(defun ,sym ()
 755        (interactive)
 756        (setq  ,variable , value))))
 757
 758 ;;; ----------------------------------------------------------------------
 759 ;;;
 760 (defmacro tinycygwin-menu-call-with (menu-symbol variable)
 761   "Call MENU-SYMBOL and return content of VARIABLE."
 762   ` (progn
 763       (setq ,variable nil)
 764       (ti::menu-menu ,menu-symbol)
 765       ,variable))
 766
 767 ;;; ----------------------------------------------------------------------
 768 ;;;
 769 (defun tinycygwin-install-menu-function-list (variable-sym)
 770   "Get list of menu functions from VARIABLE-SYM.
 771 The menu item is left flushed, lowercase word that is immediately
 772 followed by indented two space explanation. An example:
 773
 774   item
 775     The item is ..."
 776   (let* ((string (tinycygwin-variable-documentation variable-sym))
 777          case-fold-search
 778          list)
 779     (when string
 780       (with-temp-buffer
 781         (insert string)
 782         (goto-char (point-min))
 783         (while (re-search-forward "^\\([a-z]+\\)[ \t]*\n[ \t]+[A-Z]" nil t)
 784           (push (match-string 1) list))))
 785     list))
 786
 787 ;;; ----------------------------------------------------------------------
 788 ;;;
 789 (defun tinycygwin-install-severity-functions ()
 790   "Generate `tinycygwin-severity-select-*' user functions."
 791   ;; Generate functions at run-time.
 792   (mapcar
 793    (lambda (x)
 794      (eval
 795       `(tinycygwin-install-menu-function-macro
 796         "tinycygwin-severity-select-%s"
 797         ,x
 798         tinycygwin-:menu-severity-selected)))
 799    (tinycygwin-install-menu-function-list
 800     'tinycygwin-:menu-severity)))
 801
 802 ;;; ----------------------------------------------------------------------
 803 ;;;
 804 (defun tinycygwin-install-bug-classification-functions ()
 805   "Generate `tinycygwin-severity-select-*' user functions."
 806   ;; Generate functions at run-time.
 807   (mapcar
 808    (lambda (x)
 809      (eval
 810       `(tinycygwin-install-menu-function-macro
 811         "tinycygwin-type-select-%s"
 812         ,x
 813         tinycygwin-:menu-bug-classification-selected)))
 814    (tinycygwin-install-menu-function-list
 815     'tinycygwin-:menu-bug-classification)))
 816
 817 ;;; ----------------------------------------------------------------------
 818 ;;;
 819 (defun tinycygwin-find-file-hooks ()
 820   "Install `font-lock-keywords' for log files."
 821   (tinycygwin-font-lock-keywords))
 822
 823 ;;; ----------------------------------------------------------------------
 824 ;;;
 825 (defun tinycygwin-install-font-lock-keywords (&optional uninstall)
 826   "Install colors to all current buffers."
 827   (dolist (buffer (buffer-list))
 828     (with-current-buffer buffer
 829       (tinycygwin-font-lock-keywords uninstall))))
 830
 831 ;;; ----------------------------------------------------------------------
 832 ;;;
 833 (defun tinycygwin-message-mode-help ()
 834   "Return quick help of additional commands."
 835   (substitute-command-keys
 836    (concat
 837     "Insert (file) "
 838     "\\[tinycygwin-insert-attach-file-as-is] "
 839     "(Env. var) "
 840     "\\[tinycygwin-insert-environment-variable-content] "
 841     "(cygcheck) "
 842     "\\[tinycygwin-message-mode-attach-cygcheck]")))
 843
 844 ;;; ----------------------------------------------------------------------
 845 ;;;
 846 (defun tinycygwin-message-mode-help-simple ()
 847   "Return quick help of additional commands."
 848   (concat
 849    "Additional Cygwin related commands at C-c C-p C-h"))
 850
 851 ;;; ----------------------------------------------------------------------
 852 ;;;
 853 (defun tinycygwin-message-mode-faces ()
 854   "Use custom faces."
 855   ;;  The defaults are not readable in Cygwin white/black rxvt
 856   (set-face-foreground
 857    'message-header-name-face
 858    (face-foreground 'font-lock-string-face))
 859   (set-face-foreground
 860    'message-header-cc-face
 861    (face-foreground 'font-lock-constant-face))
 862   (set-face-foreground
 863    'message-header-to-face
 864    (face-foreground 'font-lock-builtin-face)))
 865
 866 ;;; ----------------------------------------------------------------------
 867 ;;;
 868 (defun tinycygwin-message-mode-hook ()
 869   "Install extra Cygwin specific keybindings to `message-mode'."
 870   (when (boundp 'message-mode-map)
 871     (tinycygwin-tab-to-tab-stop-4-spaces message-mode-map)
 872     (define-key message-mode-map "\C-C\C-pa"
 873       'tinycygwin-insert-attach-file-as-is)
 874     (define-key message-mode-map "\C-C\C-pc"
 875       'tinycygwin-message-mode-attach-cygcheck)
 876     (define-key message-mode-map "\C-C\C-pe"
 877       'tinycygwin-insert-environment-variable-content)
 878     (define-key message-mode-map "\C-C\C-p-"
 879       'font-lock-mode)
 880     (define-key message-mode-map "\C-C\C-p\C-r"
 881       'rename-uniquely)
 882     (define-key message-mode-map "\C-C\C-pv"
 883       'tinycygwin-message-mode-attach-program-version)))
 884
 885 ;;; ----------------------------------------------------------------------
 886 ;;;
 887 (defun tinycygwin-install-message-mode (&optional uninstall)
 888   "Install extra Cygwin specific keybindings to `message-mode'."
 889   (if uninstall
 890       (remove-hook 'message-mode-hook 'tinycygwin-message-mode-hook)
 891     (add-hook 'message-mode-hook 'tinycygwin-message-mode-hook)))
 892
 893 ;;; ----------------------------------------------------------------------
 894 ;;;
 895 ;;;###autoload
 896 (defun tinycygwin-install (&optional uninstall)
 897   "Install or optionally UNINSTALL (i.e. inactivate) this lisp package."
 898   (interactive "P")
 899   (when nil
 900     (cond
 901      (uninstall
 902       (tinycygwin-install-font-lock-keywords 'uninstall)
 903       (remove-hook 'find-file-hooks 'tinycygwin-find-file-hooks)
 904       nil)
 905      (t
 906       (tinycygwin-install-font-lock-keywords)
 907       (add-hook 'find-file-hooks  'tinycygwin-find-file-hooks)
 908       nil))))
 909
 910 ;;}}}
 911 ;;{{{ Email functions
 912
 913 ;;; ----------------------------------------------------------------------
 914 ;;;
 915 (defun tinycygwin-insert-attach-file-as-is (file)
 916   "Insert FILE attachment \"as is\" to the end of buffer.
 917 This is different than a regular MIME attachment that is
 918 inserted in `message-mode' with \\[mml-attach-file]."
 919   (interactive "FAttach file as is: ")
 920   (save-current-buffer
 921     (goto-char (point-max))
 922     (tinycygwin-bug-report-mail-attach-file file)))
 923
 924 ;;; ----------------------------------------------------------------------
 925 ;;;
 926 (defun tinycygwin-insert-environment-variable-content (var)
 927   "Inser content of environment variable VAR at point."
 928   (interactive
 929    (list
 930     (completing-read
 931      "Iinsert environment variable: "
 932      (mapcar
 933       (lambda (x)
 934         (if (string-match "^\\(.+\\)=\\(.*\\)" x)
 935             (cons (match-string 1 x)
 936                   (match-string 2 x))
 937           (cons "__NOT_FOUND__" . 1)))
 938       process-environment)
 939      nil
 940      'match)))
 941   (when var
 942     (let ((value (getenv var)))
 943       (insert (format "%s=%s" var (or (getenv var) ""))))))
 944
 945 ;;; ----------------------------------------------------------------------
 946 ;;;
 947 (defun tinycygwin-message-mode-attach-cygcheck ()
 948   "Insert cygcheck retults to the end of buffer as a MIME attachement."
 949   (interactive)
 950   (let* ((file (make-temp-file "emacs-tinycygwin-cygcheck"))
 951          point
 952          status)
 953     (save-current-buffer
 954       (goto-char (point-max))
 955       (message "Wait, calling cygcheck [may take a while]... ")
 956       (with-temp-buffer
 957         (tinycygwin-sysinfo-insert-os-cygwin)
 958         (write-region (point-min) (point-max) file))
 959       (message "Wait, calling cygcheck [may take a while]... Done.")
 960       (tinycygwin-bug-report-mail-insert-files (list file) 'mime))))
 961
 962 ;;; ----------------------------------------------------------------------
 963 ;;;
 964 (defun tinycygwin-program-parse-version ()
 965   "Parse version information from program's version output."
 966   (let* ((list  '(("[0-9]+\\.[0-9]+\\([0-9.]+\\)?" 0)))
 967          version)
 968     (dolist (elt list)
 969       (goto-char (point-min))
 970       (multiple-value-bind (regexp subexp) elt
 971         (when (and (re-search-forward regexp nil t)
 972                    (setq version (match-string subexp)))
 973           (return))))
 974     version))
 975
 976 ;;; ----------------------------------------------------------------------
 977 ;;;
 978 (defun tinycygwin-message-mode-attach-program-version
 979   (program &optional opt mode)
 980   "Insert version information of PROGRAM calling with optional OPT.
 981
 982 Possible values for variable MODE
 983
 984   'end    Insert to the end of buffer.
 985   'ask    Ask user what to do.
 986   nil     Insert at point."
 987   (interactive
 988    (list
 989     (read-string "Progam name: "
 990                  nil 'tinycygwin-:history-ask-program)
 991     (read-string "Version option [--version by default]: "
 992                  nil tinycygwin-:history-ask-version)
 993     'ask))
 994   (let* ((file (make-temp-file
 995                 (format
 996                  "emacs-tinycygwin-program-version-%s" program)))
 997          (try-opt (if (or (null opt)
 998                           (and (stringp opt)
 999                                (string= opt "")))
1000                       '("--version" "-V" "-v")
1001                     (list opt)))
1002          (bin     (if (not (string-match "[\\/]" program))
1003                       (executable-find program)
1004                     program))
1005          point
1006          status
1007          version)
1008     (unless bin
1009       (error "TinyCygwin: [ERROR] %s not found in PATH" program))
1010     (save-current-buffer
1011       (dolist (option try-opt)
1012         (message "Wait, calling %s %s ... "
1013                  program option)
1014         (with-temp-buffer
1015           (call-process bin
1016                         nil              ;infile
1017                         (current-buffer) ;buffer
1018                         nil              ;display
1019                         option)
1020           (when (setq version (tinycygwin-program-parse-version))
1021             (write-region (point-min) (point-max) file)
1022             (setq opt option)
1023             (return))))
1024       (cond
1025        ((null version)
1026         (message "Couldn't read version information. Please insert manually."))
1027        (t
1028         (let ((action (if (eq mode 'ask)
1029                           (if (y-or-n-p
1030                                "Insert at point or to the end of buffer? ")
1031                               nil
1032                             'end)
1033                         mode)))
1034           (cond
1035            ((eq action 'end)
1036             (goto-char (point-max))
1037             (tinycygwin-bug-report-mail-attach-file file))
1038            (t
1039             (insert-file-contents-literally file)))))))))
1040
1041 ;;; ----------------------------------------------------------------------
1042 ;;;
1043 (defun tinycygwin-user-mail-address-valid-p (email)
1044   "Check if EMAIL address look valid."
1045   (and (stringp email)
1046        ;; foo@this.net
1047        ;; ||  ||  |  |
1048        ;; 12  34  5  6
1049        ;;
1050        ;; 1. start with non-whitespace
1051        ;; 2. followed by anything until @
1052        ;; 3. continue non-whitespace
1053        ;; 4. followed by anything until
1054        ;; 5. Must have period "."
1055        ;; 6. continue non-whitespace
1056        (string-match
1057         (concat
1058          "^"
1059          "[ \t]*"
1060          "[^ \t\r\n]+.*@[^ \t\r\n]+.*\\.[^ \t\r\n]+"
1061          "[ \t]*"
1062          "$")
1063         email)
1064        email))
1065
1066 ;;; ----------------------------------------------------------------------
1067 ;;;
1068 (defun tinycygwin-user-full-name-valid-p (str)
1069   "Check if STR includes valid 'Firstname Lastname'."
1070   (and (stringp str)
1071        (let (case-fold-search)
1072          (string-match "^[^ \t\r\n]+ +[^ \t\r\n]" str))))
1073
1074 ;;; ----------------------------------------------------------------------
1075 ;;;
1076 (defun tinycygwin-user-mail-address-value (&optional email)
1077   "Check `user-mail-address' and read environment variable EMAIL.
1078 Return correct email address or nil."
1079   (dolist (try (list
1080                 email
1081                 tinycygwin-:external-email-address
1082                 (and (boundp 'message-user-mail-address)
1083                      message-user-mail-address)
1084                 (and (boundp 'user-mail-address)
1085                      user-mail-address)
1086                 (getenv "EMAIL")))
1087     (if (and (stringp try)
1088              (tinycygwin-user-mail-address-valid-p try))
1089         (return try))))
1090
1091 ;;; ----------------------------------------------------------------------
1092 ;;;
1093 (defun tinycygwin-user-mail-address-set ()
1094   "Set `user-mail-address' from possible addresses; the one that is valid.
1095 If `user-mail-address' is already valid, do nothing. If cannot set,
1096 call `error'."
1097   (unless (tinycygwin-user-mail-address-valid-p user-mail-address)
1098     (let ((value (tinycygwin-user-mail-address-value)))
1099       (unless value
1100         (error (concat "** [ERROR] Can't determine `user-mail-address'."
1101                        "Please define environemnt variable EMAIL.")))
1102       (setq user-mail-address value))))
1103
1104 ;;; ----------------------------------------------------------------------
1105 ;;;
1106 (defun tinycygwin-user-full-name-set ()
1107   "Set `user-full-name' from environment.
1108 The varaibles NAME and DEBFULLNAME are examine if  `user-full-name'
1109 does not contain space separated Firstname Lastname."
1110   (unless (tinycygwin-user-full-name-valid-p user-full-name)
1111     (let ((name (or (getenv "NAME")
1112                     (getenv "DEBFULLNAME"))))
1113       (unless name
1114         (error "TinyCygwin: [ERROR] Can't set `user-full-name'. %s"
1115                "Please define environment variable NAME."))
1116       (setq user-full-name name))))
1117
1118 ;;; ----------------------------------------------------------------------
1119 ;;;
1120 (defun tinycygwin-user-mail-address-fix-angles ()
1121   "Add <> around email in current buffer."
1122   (goto-char (point-min))
1123   (when (re-search-forward "@" nil t)
1124     (skip-chars-backward "^ ")
1125     (insert "<")
1126     (skip-chars-forward "^ ")
1127     (insert ">")
1128     (buffer-string)))
1129
1130 ;;; ----------------------------------------------------------------------
1131 ;;;
1132 (defun tinycygwin-user-mail-address-correct (str)
1133   "Correct words like 'A T' as @ etc."
1134   (with-temp-buffer
1135     (insert str)
1136     (dolist (elt tinycygwin-:email-address-correct-list)
1137       (goto-char (point-min))
1138       (while (re-search-forward (car elt) nil t)
1139         (replace-match (nth 1 elt))))
1140     (buffer-string)))
1141
1142 ;;; ----------------------------------------------------------------------
1143 ;;;
1144 (defun tinycygwin-user-mail-address-fix (list)
1145   "Add missing <> around LIST of email addresses like '(me@example.com)."
1146   (when list
1147     (with-temp-buffer
1148       (let (ret)
1149         (dolist (str list)
1150           (when (and (stringp str)
1151                      (setq str (tinycygwin-user-mail-address-correct str))
1152                      (string-match "@" str))
1153             (unless (string-match "[<>]" str)
1154               (erase-buffer)
1155               (insert str)
1156               (setq str
1157                     (tinycygwin-user-mail-address-fix-angles)))
1158             (push str ret)))
1159         (reverse ret)))))
1160
1161 ;;}}}
1162 ;;{{{ Utility functions
1163
1164 ;;; ----------------------------------------------------------------------
1165 ;;;
1166 (put 'tinycygwin-debug 'edebug-form-spec '(body))
1167 (put 'tinycygwin-debug 'lisp-indent-function 0)
1168 (defmacro tinycygwin-clean-system-with (&rest body)
1169   "Disable almost all auto-features and run BODY."
1170   `(let (auto-mode-alist
1171          find-file-hooks
1172          interpreter-mode-alist)
1173      ,@body))
1174
1175 ;;; ----------------------------------------------------------------------
1176 ;;;
1177 (put 'tinycygwin-debug 'edebug-form-spec '(body))
1178 (put 'tinycygwin-debug 'lisp-indent-function 0)
1179 (defmacro tinycygwin-debug (&rest body)
1180   "Run BODY when tinycygwin-:debug is non-nil."
1181   `(when tinycygwin-:debug
1182      ,@body))
1183
1184 ;;; ----------------------------------------------------------------------
1185 ;;;
1186 (put 'tinycygwin-external-with 'edebug-form-spec '(body))
1187 (put 'tinycygwin-external-with 'lisp-indent-function 0)
1188 (defmacro tinycygwin-external-with (&rest body)
1189   "Run BODY if this is external call.
1190 References:
1191   `tinycygwin-:external-call-flag'
1192   `tinycygwin-:external-call-flag-value'"
1193   `(when (or tinycygwin-:external-call-flag
1194              tinycygwin-:external-call-flag-value)
1195      ,@body))
1196
1197 ;;; ----------------------------------------------------------------------
1198 ;;;
1199 (put 'tinycygwin-expert-with 'edebug-form-spec '(body))
1200 (put 'tinycygwin-expert-with 'lisp-indent-function 0)
1201 (defmacro tinycygwin-expert-with (&rest body)
1202   "Run BODY if `tinycygwin-:expert-flag' is no-nil."
1203   `(when tinycygwin-:expert-flag
1204      ,@body))
1205
1206 ;;; ----------------------------------------------------------------------
1207 ;;;
1208 (put 'tinycygwin-non-expert-with 'edebug-form-spec '(body))
1209 (put 'tinycygwin-non-expert-with 'lisp-indent-function 0)
1210 (defmacro tinycygwin-non-expert-with (&rest body)
1211   "Run BODY if `tinycygwin-:expert-flag' is nil."
1212   `(unless tinycygwin-:expert-flag
1213      ,@body))
1214
1215 ;;; ----------------------------------------------------------------------
1216 ;;;
1217 (put 'tinycygwin-not-modified-with 'edebug-form-spec '(body))
1218 (put 'tinycygwin-not-modified-with 'lisp-indent-function 0)
1219 (defmacro tinycygwin-not-modified-with (&rest body)
1220   "Mark buffer as not modified after BODY."
1221   `(progn
1222      ,@body
1223      (set-buffer-modified-p nil)))
1224
1225 ;;; ----------------------------------------------------------------------
1226 ;;;
1227 (defun tinycygwin-email-choice-list (&optional package)
1228   "Return list of Email choices for for user with `completing-read'."
1229   (let ((list
1230          (list
1231           tinycygwin-:email-cygwin-users-list
1232           tinycygwin-:email-cygwin-apps-list
1233           (if (and package
1234                    (not (string-match "^x" package)))
1235               nil
1236             tinycygwin-:email-cygwin-xfree-list)
1237           (unless package
1238             (tinycygwin-maintainer)))))
1239     (delq nil list)))
1240
1241 ;;; ----------------------------------------------------------------------
1242 ;;;
1243 (defsubst tinycygwin-bug-report-email-prefix (&optional type)
1244   "Return Subejct's bug prefix string 'Cygwin-TYPE#YYYYMMDDTHHMM'
1245 The time is in UTC and similar to 'date ----iso-8601=minutes'
1246 The TYPE is 'bug' by default, but can also be other type, like
1247 rfa, rfp, itp, orphan, update. See `tinycygwin-:menu-wnpp'."
1248   (format
1249    ;;  Cygwin-bug#NNNN Linux-Bug#NNNN
1250    (concat (if tinycygwin-:os-type
1251                (format "%s-" (capitalize (symbol-name tinycygwin-:os-type)))
1252              "")
1253            "%s#%s")
1254    (or type
1255        "bug")
1256    ;; XEmacs does not support argument UTC
1257    (if (featurep 'xemacs)
1258        (format-time-string "%Y%m%dT%H%M")
1259      (format-time-string "%Y%m%dT%H%M" nil 'utc))))
1260
1261 ;;; ----------------------------------------------------------------------
1262 ;;;
1263 (defsubst tinycygwin-bug-report-email-buffer-name (package &optional type)
1264   "Compose *mail* buffer name string using PACKAGE.
1265 Optional TYPE is by deault \"bug\"."
1266   (format "*mail* Cygwin %s%s"
1267           (or type
1268               "bug")
1269           (if (and package
1270                    (not (string= "" package)))
1271               (format " (%s)" package)
1272             "")))
1273
1274 ;;; ----------------------------------------------------------------------
1275 ;;;
1276 (defsubst tinycygwin-string-trim (string)
1277   "Delete leading and trailing spaces."
1278   (when string
1279     (replace-regexp-in-string "^[ \t]+" "" string)
1280     (replace-regexp-in-string "[ \t]+$" "" string)
1281     string))
1282
1283 ;;; ----------------------------------------------------------------------
1284 ;;;
1285 (defsubst tinycygwin-bug-report-include-buffer-name-p (str)
1286   "Check buffer name STR is Bug report include file."
1287   (string-match "tinycygwin include" (or str "")))
1288
1289 ;;; ----------------------------------------------------------------------
1290 ;;;
1291 (defsubst tinycygwin-bug-report-include-buffer-name (str)
1292   "Convert string into buffer name that would be included in Bug report."
1293   (unless (tinycygwin-bug-report-include-buffer-name-p str)
1294     (format "*tinycygwin include %s*" (buffer-name))))
1295
1296 ;;; ----------------------------------------------------------------------
1297 ;;;
1298 (defsubst tinycygwin-bug-report-include-buffer-list ()
1299   "Return list of Bug report include buffers."
1300   (let (list)
1301     (dolist (buffer (buffer-list))
1302       (with-current-buffer buffer
1303         (when (and (buffer-file-name)
1304                    (tinycygwin-bug-report-include-buffer-name-p
1305                     (buffer-name)))
1306           (push buffer list))))
1307     list))
1308
1309 ;;; ----------------------------------------------------------------------
1310 ;;;
1311 (defsubst tinycygwin-msg-exit-emacs ()
1312   "Return string to say how to exit Emacs."
1313   (substitute-command-keys
1314    "Exit Emacs \\[save-buffers-kill-emacs]"))
1315
1316 ;;; ----------------------------------------------------------------------
1317 ;;;
1318 (defsubst tinycygwin-goto-mail-header-separator ()
1319   "Goto start of body after `mail-header-separator'.
1320 If not found, goto `point-max'."
1321   (goto-char (point-min))
1322   (or (and (boundp 'mail-header-separator)
1323            (re-search-forward
1324             (concat "^" (regexp-quote mail-header-separator) "\n")
1325             nil t))
1326       (re-search-forward "^--text.*\n" nil t)
1327       (goto-char (point-max))))
1328
1329 ;;; ----------------------------------------------------------------------
1330 ;;;
1331 (defsubst tinycygwin-goto-body-start ()
1332   "Go to start of body, skipping all headers."
1333   (goto-char (point-min))
1334   (or (re-search-forward "\n\n" nil t)
1335       (re-search-forward "^[ \t]*$" nil t)
1336       (goto-char (point-max))))
1337
1338 ;;; ----------------------------------------------------------------------
1339 ;;;
1340 (defsubst tinycygwin-pop-to-buffer (buffer)
1341   "Show buffer in full window."
1342   (pop-to-buffer buffer)
1343   (delete-other-windows))
1344
1345 ;;; ----------------------------------------------------------------------
1346 ;;;
1347 (defsubst tinycygwin-bug-report-mail-mode-prepare ()
1348   "Prepare current buffer for bug email."
1349   (message "tinycygwin-bug-report-mail-mode-prepare: external %s"
1350            tinycygwin-:external-call-flag)
1351   (tinycygwin-external-with
1352    (message "tinycygwin-bug-report-mail-mode-prepare: buffer %s"
1353             (buffer-name))
1354    (make-local-variable 'tinycygwin-:external-call-flag-value)
1355    ;;  Save the current state permanently to this buffer
1356    (setq tinycygwin-:external-call-flag-value
1357          tinycygwin-:external-call-flag)))
1358
1359 ;;; ----------------------------------------------------------------------
1360 ;;;
1361 (defsubst tinycygwin-bug-report-mail-mode-buffer (name)
1362   "Return emty buffer with NAME and prepare it."
1363   (tinycygwin-user-mail-address-set)
1364   (tinycygwin-user-full-name-set)
1365   (let ((buffer (get-buffer-create name)))
1366     (with-current-buffer buffer
1367       (tinycygwin-bug-report-mail-mode-prepare))
1368     buffer))
1369
1370 ;;; ----------------------------------------------------------------------
1371 ;;;
1372 (defun tinycygwin-bug-report-mail-mode-finish-message ()
1373   "Show message until user starts doing something."
1374   (let* ((msg1   (tinycygwin-message-mode-help-simple))
1375          (msg2   (substitute-command-keys
1376                   (concat
1377                    "Write description and send with "
1378                    "\\[message-send-and-exit] "
1379                    "("
1380                    "Help \\[describe-mode] "
1381                    (tinycygwin-external-with
1382                     (tinycygwin-msg-exit-emacs))
1383                    ")")))
1384          (list (list msg1
1385                      msg2)))
1386     (while (and (sit-for 0.2)
1387                 (not (input-pending-p))
1388                 (message (car list))
1389                 ;;  Rotate list of messages
1390                 (let ((tmp (pop list)))
1391                   (setq list (append list (list tmp))))
1392                 (sit-for 5)))))
1393
1394 ;;; ----------------------------------------------------------------------
1395 ;;;
1396 (defun tinycygwin-bug-report-mail-mode-finish ()
1397   "Finish mail buffer preparations."
1398   (tinycygwin-bug-report-mail-mode-subject-fix)
1399   (set-buffer-modified-p nil)
1400   ;; (setq buffer-auto-save-file-name nil)
1401   (tinycygwin-goto-body-start)
1402   (tinycygwin-non-expert-with
1403    (tinycygwin-bug-report-mail-mode-finish-message)))
1404
1405 ;;; ----------------------------------------------------------------------
1406 ;;;
1407 (defun tinycygwin-update-file-autoloads (dir)
1408   "Generate autoloads in DIR."
1409   (let* ((default-directory dir)
1410          (generated-autoload-file
1411           (concat (file-name-as-directory dir)
1412                   "tinycygwin-autoloads.el")))
1413     (unless (file-exists-p generated-autoload-file)
1414       (message "TinyCygwin: [WARN] %s does not exist. Creating it."
1415                generated-autoload-file)
1416       (with-temp-buffer
1417         (insert (format ";; Emacs autoload file. File was generated %s\n\n"
1418                         (format-time-string
1419                          "%Y-%m-%d %H:%M UTC" nil 'utc)))
1420         (write-region (point-min) (point-max) generated-autoload-file)))
1421     (dolist (file (directory-files dir nil "\\.el$" 'abs))
1422       (unless (string-match "loaddefs\\|autoload\\|[#~]" file)
1423         (update-file-autoloads file)))
1424     (let ((buffer (get-file-buffer generated-autoload-file)))
1425       (when buffer
1426         (with-current-buffer buffer
1427           (save-buffer))
1428         (kill-buffer buffer)))))
1429
1430 ;;; ----------------------------------------------------------------------
1431 ;;;
1432 ;;;###autoload
1433 (defun tinycygwin-update-file-autoloads-batch (&optional dir force)
1434   "Update autoloads in batch mode. Argument in command line is DIR. FORCE."
1435   (interactive "DAutoload dir to update: ")
1436   (unless dir
1437     (setq dir (pop command-line-args-left))
1438     (setq force t))
1439   (unless dir
1440     ;; Self generate error for command line ...
1441     (message "TinyCygwin: From what directory to generate autoloads?")
1442     (error 'tinycygwin-update-file-autoloads-batch))
1443   (message "TinyCygwin: Generating all autoloads in %s" dir)
1444   (tinycygwin-update-file-autoloads dir))
1445
1446 ;;; ----------------------------------------------------------------------
1447 ;;;
1448 (defun tinycygwin-smtp-available-p (&optional force)
1449   "Open smtå to see if mail is available. The value is cached unless FORCE."
1450   (when (file-directory-p "/cygdrive/c") ;; Try only in Windows
1451     (let ((checked (get 'tinycygwin-smtp-available-p 'checked))
1452           (status  (get 'tinycygwin-smtp-available-p 'status))
1453           proc)
1454       (when (or force
1455                 (null checked))
1456         (message "Tinycygwin: Checking SMTP server... ")
1457         (setq status
1458               (condition-case error
1459                   (setq proc
1460                         (open-network-stream
1461                          "tinycygwin-smtp"
1462                          "*process-tinycygwin-smtp*"
1463                          "localhost"
1464                          25))
1465                 (error
1466                  nil)
1467                 (t
1468                  (delete-process proc)
1469                  t))))
1470       (message "Tinycygwin: Checking SMTP server... Done.")
1471       (put 'tinycygwin-smtp-available-p 'checked t)
1472       (put 'tinycygwin-smtp-available-p 'status status))))
1473
1474 ;;; ----------------------------------------------------------------------
1475 ;;;
1476 (defun tinycygwin-smtp-setup-error ()
1477   "Check that Emacs can in theory send mail.
1478 Call `error' if there are problems."
1479   (unless (or (getenv "SMTPSERVER")
1480               (tinycygwin-smtp-available-p))
1481     (read-string
1482      "TinyCygwin: [ERROR] No SMTPSERVER defined <press return> ")
1483     (pop-to-buffer (get-buffer-create "*tinycygwin.el help*"))
1484     (erase-buffer)
1485     (insert "\
1486 \[Email configuration error]
1487
1488 To activate Emacs email support for ISP's mailserver, following
1489 lines are needed in personal startup file ~/.emacs
1490
1491 \(setenv \"SMTPSERVER\" \"your.isp.example.net\")
1492 \(setq smtpmail-debug-info           t)
1493 \(setq smtpmail-local-domain         nil)
1494 \(setq send-mail-function            'smtpmail-send-it)
1495 \(setq message-send-mail-function    'smtpmail-send-it)
1496 \(setq gnus-agent-send-mail-function 'smtpmail-send-it)
1497
1498 After you have done these changes, the setings are active next time Emacs
1499 is started. Here are few inportant Eamcs commands to help you:
1500
1501   C-x C-c   Quit
1502   C-g       Abort current (active) operation, like prompt input
1503
1504   C-x o     Go to (o)ther visible window
1505   C-x C-f   Open file for editing
1506   C-x C-s   Save current file
1507   C-x C-b   Show buffer list (C-x o to it and press RET to select)
1508
1509   C-k       Kill line (at the same time copies it)
1510   C-y       Yank, paste
1511 ")
1512     (when (y-or-n-p "Open ~/.emacs for editing? ")
1513       (pop-to-buffer (find-file-noselect "~/.emacs")))
1514     (message
1515      "Unable continue before before working email. %s"
1516      (tinycygwin-msg-exit-emacs))
1517     'error))
1518
1519 ;;; ----------------------------------------------------------------------
1520 ;;;
1521 (defsubst tinycygwin-buffer-name-temp (name)
1522   "Return temporary buffer for NAME"
1523   (format "*tinycygwin %s*" name))
1524
1525 ;;; ----------------------------------------------------------------------
1526 ;;;
1527 (defun tinycygwin-file-buffer (file)
1528   "Return buffer for FILE."
1529   (when file
1530     (let* ((name   (tinycygwin-buffer-name-temp
1531                     (file-name-nondirectory file)))
1532            (buffer (get-buffer name)))
1533       (unless buffer
1534         (with-current-buffer (setq buffer (get-buffer-create name))
1535           (insert-file-literally file)
1536           (setq buffer-read-only t)))
1537       buffer)))
1538
1539 ;;; ----------------------------------------------------------------------
1540 ;;;
1541 (defsubst tinycygwin-first-directory (list)
1542   "Return Cygwin package documentation root directory"
1543   (dolist (dir list)
1544     (when (file-directory-p dir)
1545       (return dir))))
1546
1547 ;;; ----------------------------------------------------------------------
1548 ;;;
1549 (defun tinycygwin-path-to-cygwin (path)
1550   "Chnage Win32 path to Cygwin path."
1551   (let* ((root tinycygwin-:root-dir))
1552     (when (and path
1553                (stringp path))
1554       (replace-regexp-in-string root "" path))))
1555
1556 ;;; ----------------------------------------------------------------------
1557 ;;;
1558 (defun tinycygwin-path (path)
1559   "Convert Cygwin PATH, like /, to OS absolute patch like C:/cygwin.
1560  Trailing slash is stripped."
1561   (when path
1562     (let* ((root tinycygwin-:root-dir)
1563            ret)
1564       (setq ret
1565             (cond
1566              ((string= root "/")
1567               path) ;; Native Cygwin Emacs
1568              ((string-match "^/cygdrive" path)
1569               path)
1570              ((string-match "^/\\(.*\\)" path)
1571               (format
1572                "%s%s"
1573                (file-name-as-directory root)
1574                (match-string 1 path)))
1575              (t
1576               path)))
1577       ;; Delete trailing slash.
1578       (if (string-match "^\\(.+\\)/$" ret)
1579           (match-string 1 ret)
1580         ret))))
1581
1582 ;;; ----------------------------------------------------------------------
1583 ;;;
1584 (defun tinycygwin-path-doc-cygwin ()
1585   "Return Cygwin package documentation root directory"
1586   (tinycygwin-path
1587    (tinycygwin-first-directory tinycygwin-:path-doc-cygwin-list)))
1588
1589 ;;; ----------------------------------------------------------------------
1590 ;;;
1591 (defun tinycygwin-path-doc-root ()
1592   "Return Cygwin package documentation root directory"
1593   (tinycygwin-path
1594    (tinycygwin-first-directory tinycygwin-:path-doc-root-list)))
1595
1596 ;;; ----------------------------------------------------------------------
1597 ;;;
1598 (defsubst tinycygwin-string-delete-newlines (string)
1599   "Delete newlines from STRING."
1600   (replace-regexp-in-string "[\r\n]" "" string))
1601
1602 ;;; ----------------------------------------------------------------------
1603 ;;;
1604 ;;;###autoload
1605 (defun tinycygwin-turn-on-emacs-debug ()
1606   "Activate Emacs debug."
1607   (interactive)
1608   (setq debug-on-error t)
1609   (if (boundp 'stack-trace-on-error) ;; XEmacs
1610       (setq stack-trace-on-error t))
1611   (if (boundp 'debug-ignored-errors)
1612       (setq debug-ignored-errors nil)))
1613
1614 ;;; ----------------------------------------------------------------------
1615 ;;;
1616 (defun tinycygwin-font-lock-keywords (&optional uninstall)
1617   "Add color support to various log files by setting
1618 `font-lock-keywords'."
1619   (let* ((today   "xxx") ;; (ti::date-standard-rfc-regexp "mon-date"))
1620          ;; (cs     (or comment-start-skip "[ \t]+"))
1621          (file   "")
1622          keywords)
1623
1624     (when (stringp buffer-file-name)
1625       (setq file (or buffer-file-name "no-name?")))
1626
1627     (setq
1628      keywords
1629      (cond
1630
1631       ;; ............................................. Linux log files ...
1632       ;; /var/log/
1633
1634       ((string-match "/log/messages$" file)
1635        ;; font-lock-constant-face
1636        (make-local-variable 'font-lock-defaults)
1637        (setq font-lock-keywords
1638              (list
1639               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1640                     0 'font-lock-function-name-face)
1641               (list
1642                (concat
1643                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1644                0 'font-lock-reference-face)
1645               (list
1646                (concat "restarted\\|started"
1647                        "\\|ignoring"
1648                        "\\|Linux version.*")
1649                0 'font-lock-comment-face))))
1650
1651       ((string-match "mail\\.log\\|mail\\.info" file)
1652        ;; font-lock-constant-face
1653        (make-local-variable 'font-lock-defaults)
1654        (setq font-lock-keywords
1655              (list
1656               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1657                     0 'font-lock-function-name-face)
1658               (list
1659                (concat
1660                 "^... +[0-9]+ ++[0-9]+:+[0-9]+:+[0-9]+")
1661                0 'font-lock-reference-face)
1662               '("timed out\\|did not.*"
1663                 0 tinycygwin-:warn-face)
1664               (list
1665                (concat "\\(from\\|to\\)=\\([^ ,\t\r\n]+\\)")
1666                2 'font-lock-comment-face))))
1667
1668       ((string-match "daemon\\.log" file)
1669        ;; font-lock-constant-face
1670        (make-local-variable 'font-lock-defaults)
1671        (setq font-lock-keywords
1672              (list
1673               (list
1674                (concat
1675                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1676                0 'font-lock-reference-face)
1677               (list
1678                (concat "connection attempt" ;);  See "iplogger" package
1679                                       0 'tinycygwin-:warn-face)
1680               (list
1681                (concat "signal +[0-9]+\\|no such user"
1682                        "\\|connect from .*")
1683                0 'font-lock-comment-face)))))
1684
1685       ((string-match "auth\\.log" file)
1686        ;; font-lock-constant-face
1687        (make-local-variable 'font-lock-defaults)
1688        (setq font-lock-keywords
1689              (list
1690               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1691                     0 'font-lock-function-name-face)
1692               (list
1693                (concat
1694                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1695                0 'font-lock-reference-face)
1696               (list
1697                (concat "opened +for +[^ \t\r\n]+")
1698                0 'tinycygwin-:warn-face)
1699               '( "for user \\(root\\)"
1700                  1 font-lock-string-face)
1701               '( "from \\([^ \t\r\n]+\\)"
1702                  1 font-lock-type-face)
1703               '( "for +\\([^ \t\r\n]+\\) +from"
1704                  1 font-lock-comment-face)
1705               '( "for user +\\([^ \t\r\n]+\\)"
1706                  1 font-lock-comment-face))))
1707
1708       ((string-match "syslog" file)
1709        ;; font-lock-constant-face
1710        (make-local-variable 'font-lock-defaults)
1711        (setq font-lock-keywords
1712              (list
1713               (list (concat today " +[0-9]+:+[0-9]+:+[0-9]+")
1714                     0 'font-lock-function-name-face)
1715               (list
1716                (concat
1717                 "^... +[0-9]+ +[0-9]+:+[0-9]+:+[0-9]+")
1718                0 'font-lock-reference-face)
1719               (list
1720                (concat "Invalid.*"
1721                        ;; portmap[135]: cannot bind udp: Address already in use
1722                        "\\|cannot"
1723                        "\\|Connection timed out"
1724                        ;;  See iplogger(1)
1725                        "\\|connection attempt"
1726                        ;;  See portsentry(1)
1727                        "\\|attackalert:.* +to +.*port.*"
1728                        ;;  apm -s failed
1729                        "\\| failed"
1730                        "\\|did not .*")
1731                0 'tinycygwin-:warn-face)
1732               '("to=\\([^ \t\r\n]+\\)"
1733                 1 font-lock-comment-face)
1734               '("(\\([^ )\t\r\n]+\\)) CMD "
1735                 1 font-lock-comment-face)
1736               '("CMD .*"
1737                 0 font-lock-constant-face)
1738               '("inetd"2
1739                 0 font-lock-type-face)
1740               (list
1741                (concat
1742                 "program exit.*\\|.*started.*"
1743                 ;;  btpd daemon
1744                 "\\|synchronisation lost")
1745                0 font-lock-keyword-face))))))
1746     (when keywords
1747       (cond
1748        (uninstall
1749         (setq font-lock-keywords nil))
1750        ((or font-lock-mode
1751             (and (boundp 'global-font-lock-mode)
1752                  global-font-lock-mode)
1753             (font-lock-mode 1))
1754         (setq font-lock-keywords keywords))))))
1755
1756 ;;}}}
1757 ;;{{{ WNPP
1758
1759 ;;; ----------------------------------------------------------------------
1760 ;;;
1761 (defsubst tinycygwin-list-match (regexp list)
1762   "Check if REGEXP matched LIST of strings."
1763   (dolist (str list)
1764     (when (string-match regexp str)
1765       (return str))))
1766
1767 ;;; ----------------------------------------------------------------------
1768 ;;;
1769 (defsubst tinycygwin-file-setup-hint-p (list)
1770   "Check if setup.hint is included in LIST of files."
1771   (tinycygwin-list-match (regexp-quote "setup.hint") list))
1772
1773 ;;; ----------------------------------------------------------------------
1774 ;;;
1775 (defun tinycygwin-call-process (binary buffer arg-list)
1776   "Call BINARY with list of ARGS and print output to current buffer or BUFFER."
1777   (apply 'call-process
1778          binary
1779          nil
1780          (or buffer (current-buffer))
1781          nil
1782          arg-list))
1783
1784 ;;; ----------------------------------------------------------------------
1785 ;;;
1786 (defun tinycygwin-package-wnpp-main-interactive ()
1787   "Ask the type of request for WNPP package.
1788 References:
1789   `tinycygwin-:menu-wnpp'
1790   `tinycygwin-:menu-wnpp-selected'"
1791   (tinycygwin-menu-call-with
1792    'tinycygwin-:menu-wnpp
1793    tinycygwin-:menu-wnpp-selected))
1794
1795 ;;; ----------------------------------------------------------------------
1796 ;;;
1797 (defun tinycygwin-bug-report-mail-compose (to-list subject)
1798   "Compose new mail using TO-LIST and SUBJECT."
1799   ;;  mail-setup: (to subject in-reply-to cc replybuffer actions)
1800   (mail-setup (or (pop to-list) "")
1801               (or subject "")
1802               nil nil nil nil)
1803   (when to-list ;; More recipients
1804     (unless (message-fetch-field "CC")
1805       ;;  This creates field as well
1806       (message-goto-cc))
1807     (let (newline
1808           address)
1809       (while to-list
1810         (setq newline (if (cdr to-list)
1811                           ",\n  "
1812                         "")
1813               address (pop to-list))
1814         (when (stringp address)
1815           (insert address newline)))))
1816   (tinycygwin-bug-report-mail-mode))
1817
1818 ;;; ----------------------------------------------------------------------
1819 ;;;
1820 (defun tinycygwin-package-wnpp-mail-generic
1821   (&optional prefix description info file-list)
1822   "Compose ITP message with optional subject PREFIX and DESCRIPTION.
1823 If there is package information, it is in INFO."
1824   (interactive)
1825   (let* ((subject (tinycygwin-bug-report-mail-subject-compose
1826                    description prefix "wnpp" ))
1827          (name    (tinycygwin-bug-report-email-buffer-name nil prefix))
1828          (buffer  (tinycygwin-bug-report-mail-mode-buffer name)))
1829     (tinycygwin-debug
1830      (message
1831       (concat
1832        "TinyCygwin: WNPP generic prefix [%s] description [%s] info: %s "
1833        "expert: %s")
1834       prefix description info tinycygwin-:expert-flag))
1835     (tinycygwin-not-modified-with
1836      (tinycygwin-pop-to-buffer buffer)
1837      (erase-buffer)
1838      (tinycygwin-bug-report-mail-compose
1839       (list tinycygwin-:email-cygwin-apps-list)
1840       subject)
1841      (when info
1842        (tinycygwin-bug-report-mail-insert-details-package
1843         info))
1844      (tinycygwin-bug-report-mail-insert-files
1845       file-list
1846       (tinycygwin-expert-with
1847        'as-is))
1848      (tinycygwin-bug-report-mail-mode-finish))))
1849
1850 ;;; ----------------------------------------------------------------------
1851 ;;;
1852 (defun tinycygwin-package-wnpp-main
1853   (request-type &optional package desc info file-list)
1854   "Submit REQUEST-TYPE against WNPP pseudo package.
1855 WNPP is used for requesting to be a new maintainer and
1856 for taking maintenance of other packages.
1857
1858 REQUEST-TYPE can be symbol:
1859
1860   'package 'orphan 'adopt or 'new.
1861
1862 Optional PACKAGE in question, DESC string and package INFO.
1863
1864 References:
1865   `tinycygwin-:menu-wnpp'."
1866   (interactive (list (tinycygwin-package-wnpp-main-interactive)))
1867   (let ((type (if (symbolp request-type)
1868                   (symbol-name request-type)
1869                 request-type)))
1870     (tinycygwin-debug
1871      (message
1872       (concat
1873        "TinyCygwin: WNPP main type [%s] package [%s] desc [%s] info: %s"
1874        " files: %s")
1875       type package desc info file-list))
1876     (cond
1877      ((not (stringp type)))
1878      ((string= type "package")
1879       (or desc
1880           (tinycygwin-non-expert-with
1881            (setq desc (read-string "[ITP] Package name -- description: "))))
1882       (unless (tinycygwin-file-setup-hint-p file-list)
1883         (let ((file (read-file-name
1884                      "[ITP] setup.hint file to include: "
1885                      nil
1886                      nil
1887                      'match)))
1888           (cond
1889            ((string-match "setup\\.hint" file))
1890            ;; Ok.
1891            ((or (string= "" file)
1892                 (file-directory-p file)) ;; User pressed return. No file.
1893             (if (y-or-n-p (format "Include file %s. Are you sure? "
1894                                   (file-name-nondirectory file))))
1895             (push file file-list)))))
1896       (tinycygwin-package-wnpp-mail-generic "ITP" desc nil file-list))
1897      ((string= type "new")
1898       (let ((desc  (read-string "[RFP] Package name -- description: ")))
1899         ;;  Check status database
1900         (tinycygwin-package-wnpp-mail-generic "RFP" desc)))
1901      ((string= type "orphan")
1902       (or package
1903           (setq package
1904                 (tinycygwin-package-read-name
1905                  "[ORPHAN] package: ")))
1906       (or info
1907           (setq info (tinycygwin-package-info-main package)))
1908       (tinycygwin-package-wnpp-mail-generic "ORPHAN" package info))
1909      ((string= type "adopt\\|rfa")
1910       (or package
1911           (setq package
1912                 (tinycygwin-package-read-name
1913                  "[ADOPT/RFA] package: ")))
1914       (or info
1915           (setq info (tinycygwin-package-info-main package)))
1916       (tinycygwin-package-wnpp-mail-generic "RFA" package info))
1917      (t
1918       ;;  Nothing to do
1919       nil))))
1920
1921 ;;}}}
1922 ;;{{{ Cygcheck
1923
1924 ;;; ----------------------------------------------------------------------
1925 ;;;
1926 (defun tinycygwin-sysinfo-insert-os-linux ()
1927   "Insert result of uname -a to buffer."
1928   (call-process "uname"
1929                 nil                     ;infile
1930                 (current-buffer)        ;buffer
1931                 nil                     ;display
1932                 "-a"))
1933
1934 ;;; ----------------------------------------------------------------------
1935 ;;;
1936 (defun tinycygwin-sysinfo-insert-os-cygwin ()
1937   "Insert result of cygcheck -s -v -r to buffer."
1938   (let ((cmd tinycygwin-:bin-cygcheck))
1939     (when cmd
1940       (call-process cmd
1941                     nil                  ;infile
1942                     (current-buffer)     ;buffer
1943                     nil                  ;display
1944                     "-s"
1945                     "-v"
1946                     "-r"))))
1947
1948 ;;; ----------------------------------------------------------------------
1949 ;;;
1950 (defun tinycygwin-sysinfo-buffer (&optional force)
1951   "Load `tinycygwin-:file-cygcheck' or FORCE (re)generating it."
1952   (let* ((file   tinycygwin-:file-cygcheck)
1953          (bin    tinycygwin-:bin-cygcheck)
1954          (name   tinycygwin-:buffer-cygcheck)
1955          (buffer (or (get-buffer name)
1956                      (get-file-buffer file))))
1957     (cond
1958      ((and (null force)
1959            buffer)
1960       buffer)
1961      ((and (null force)
1962            (file-exists-p file))
1963       (with-current-buffer (get-buffer-create name)
1964         (tinycygwin-not-modified-with
1965          (insert-file-contents-literally file))
1966         (setq buffer-read-only t)
1967         (current-buffer)))
1968      (t
1969       (when tinycygwin-:bin-cygcheck
1970         (message "Please wait, reading sysinfo (cygcheck)... ")
1971         (with-current-buffer (get-buffer-create name)
1972           (tinycygwin-not-modified-with
1973            (tinycygwin-call-process
1974             bin
1975             (current-buffer)
1976             (split-string "-s -v -r"))
1977            (write-region (point-min) (point-max) file)
1978            (setq buffer-read-only t)
1979            (setq buffer (current-buffer))))
1980         (message "Please wait, reading sysinfo (cygcheck)... Done.")
1981         buffer)))))
1982
1983 ;;; ----------------------------------------------------------------------
1984 ;;;
1985 (put 'tinycygwin-sysinfo-with 'lisp-indent-function 0)
1986 (defmacro tinycygwin-sysinfo-with (&rest body)
1987   "Run BODY at sysinfo buffer."
1988   `(let* ((buffer (tinycygwin-sysinfo-buffer)))
1989      (when buffer
1990        (with-current-buffer buffer
1991          ,@body))))
1992
1993 ;;; ----------------------------------------------------------------------
1994 ;;;
1995 (defun tinycygwin-sysinfo-version-cygcheck (program)
1996   "Search PROGRAM and it's version number from cygcheck listing."
1997   (when program
1998     (tinycygwin-sysinfo-with
1999      (goto-char (point-min))
2000      (if (not (re-search-forward
2001                "Cygwin Package Information" nil t))
2002          (tinycygwin-debug
2003           (message
2004            "TinyCygwin: [ERROR] tinycygwin-sysinfo-program; %s"
2005            "no start tag found"))
2006        (let (version)
2007          ;; Cygwin Package Information
2008          ;; Last downloaded files to: D:\ftp\cygwin\install\cygwin-install
2009          ;; Last downloaded files from: http://mirrors.sunsite.dk/cygwin
2010          ;;
2011          ;; Package                 Version
2012          ;;
2013          ;; _update-info-dir        00227-1
2014
2015          (when (re-search-forward
2016                 (format "^%s[^ \t\r\n]*[ \t]+\\([0-9][^ \t\r\n]+\\)"
2017                         program)
2018                 nil t)
2019            (match-string 1)))))))
2020
2021 ;;; ----------------------------------------------------------------------
2022 ;;;
2023 (defun tinycygwin-sysinfo-version-syscall-parse ()
2024   "Parse version number from currnt buffer."
2025   (let* (ret)
2026     (goto-char (point-min))
2027     (when (re-search-forward "\\([0-9]\\.[0-9.]*[0-9]\\)" nil t)
2028       (match-string 1))))
2029
2030 ;;; ----------------------------------------------------------------------
2031 ;;;
2032 (defun tinycygwin-executable-find (program)
2033   "Search for PROGRAM exactly from `exec-path'."
2034   (let ((regexp (format "^%s$" program))
2035         list
2036         ret)
2037     (dolist (path exec-path)
2038       (setq list (directory-files path 'full regexp))
2039       (when (and list (eq 1 (length list)))
2040         (setq ret (car list))
2041         (return)))
2042     ret))
2043
2044 ;;; ----------------------------------------------------------------------
2045 ;;;
2046 (defun tinycygwin-sysinfo-version-syscall-call (program &optional version-arg)
2047   "Search PROGRAM and its version number by calling shell.
2048 Optional VERSION-ARG defaults to --version."
2049   (when program
2050     (with-temp-buffer
2051       (let* ((bin (executable-find program))
2052              (args (list (or version-arg "--version"))))
2053         (unless bin
2054           ;;  This was not a .exe program, but a shell script or something
2055           ;;  like that. E.g. 'automake' is in /usr/bin/automake
2056           (let* ((found (tinycygwin-executable-find program))
2057                  shell)
2058             (when (and found
2059                        (setq shell (executable-find "sh")))
2060               (setq bin  shell
2061                     args (list
2062                           "-c"
2063                           (format "%s %s"
2064                                   (tinycygwin-path-to-cygwin found)
2065                                   (or version-arg "--version")))))))
2066         (when bin
2067           (tinycygwin-call-process
2068            bin
2069            (current-buffer)
2070            args)
2071           (tinycygwin-sysinfo-version-syscall-parse))))))
2072
2073 ;;; ----------------------------------------------------------------------
2074 ;;;
2075 (defun tinycygwin-sysinfo-bundle-item (item &optional call-shell)
2076   "Return version information of ITEM in `tinycygwin-:sysinfo-program-list'.
2077 If optional CALL-SHELL is non-nil, then query the information from
2078 shell (more reliable, but slower).
2079
2080 Return:
2081   '((PROGRAM VERSION)
2082     ...)."
2083   (let (ver
2084         list)
2085     (dolist (bin (cadr (assq item tinycygwin-:sysinfo-program-list)))
2086       (when (setq ver
2087                   (if call-shell
2088                       (tinycygwin-sysinfo-version-syscall-call bin)
2089                     (tinycygwin-sysinfo-version-cygcheck bin)))
2090         (push (list bin ver) list)))
2091     ;; Preserve order
2092     (reverse list)))
2093
2094 ;;; ----------------------------------------------------------------------
2095 ;;;
2096 (defun tinycygwin-sysinfo-os-kernel-version ()
2097   "Return OS details."
2098   (with-temp-buffer
2099     (tinycygwin-sysinfo-insert-os-linux)
2100     (goto-char (point-min))
2101     (when (re-search-forward "[0-9][.0-9]+-[-.0-9]+" nil t)
2102       ;; Linux host 2.6.18-1-686 #1 SMP Sat Oct 21 17:21:28 UTC 2006 i686 GNU/Linux
2103       (match-string 0))))
2104
2105 ;;; ----------------------------------------------------------------------
2106 ;;;
2107 (defun tinycygwin-sysinfo-os-linux-arch ()
2108   "Return OS details."
2109   (with-temp-buffer
2110     (insert (tinycygwin-sysinfo-os-kernel-version))
2111     (goto-char (point-min))
2112     ;;  2.6.18-1-686
2113     (when (re-search-forward "[0-9]+$" nil t)
2114       (match-string 0))))
2115 ;;; ----------------------------------------------------------------------
2116 ;;;
2117 (defun tinycygwin-sysinfo-os-windows ()
2118   "Return Windows OS details."
2119   ;; This is the first line in there
2120   ;; Windows 2000 Professional Ver 5.0 Build 2195 Service Pack 4
2121   (tinycygwin-sysinfo-with
2122    (goto-char (point-min))
2123    (when (re-search-forward "^Windows.*[^\r\n]" nil t)
2124      (match-string 0))))
2125
2126 ;;; ----------------------------------------------------------------------
2127 ;;;
2128 (defun tinycygwin-sysinfo-os-cygwin-dll-all ()
2129   "Return cygwin1.dll details."
2130   ;;Cygwin DLL version info:
2131   ;;    DLL version: 1.5.7
2132   ;;    DLL epoch: 19
2133   ;;    DLL bad signal mask: 19005
2134   ;;    DLL old termios: 5
2135   ;;    DLL malloc env: 28
2136   ;;    API major: 0
2137   ;;    API minor: 109
2138   ;;    Shared data: 3
2139   ;;    DLL identifier: cygwin1
2140   ;;    Mount registry: 2
2141   ;;    Cygnus registry name: Cygnus Solutions
2142   ;;    Cygwin registry name: Cygwin
2143   ;;    Program options name: Program Options
2144   ;;    Cygwin mount registry name: mounts v2
2145   ;;    Cygdrive flags: cygdrive flags
2146   ;;    Cygdrive prefix: cygdrive prefix
2147   ;;    Cygdrive default prefix:
2148   ;;    Build date: Fri Jan 30 19:32:04 EST 2004
2149   ;;    CVS tag: cr-0x9e
2150   ;;    Shared id: cygwin1S3
2151   (tinycygwin-sysinfo-with
2152    (goto-char (point-min))
2153    (when (re-search-forward "^[ \t]*Cygwin DLL.*info:" nil t)
2154      (let ((beg (line-beginning-position)))
2155        (when (re-search-forward "^[ \t]*$" nil t)
2156          (buffer-substring beg (line-beginning-position)))))))
2157
2158 ;;; ----------------------------------------------------------------------
2159 ;;;
2160 (defun tinycygwin-sysinfo-os-cygwin-dll-info ()
2161   "Return DLL information.
2162
2163 Return:
2164
2165 '((version \"1.5.7\")
2166   (api     \"0.109\")  ;; Major.Minor
2167   (cvs-tag     \"cr-0x9e\"))"
2168   (let* ((str (tinycygwin-sysinfo-os-cygwin-dll-all)))
2169     (when str
2170       (let (ret)
2171         (when (string-match "CVS tag:[ \t]*\\(.*[^ \t\r\n]\\)" str)
2172           (push (list 'cvs-tag (match-string 1 str)) ret))
2173         (when (string-match "DLL version:[ \t]*\\(.*[^ \t\r\n]\\)" str)
2174           (push (list 'version (match-string 1 str)) ret))
2175         (when (string-match "API major:[ \t]*\\(.*[^ \t\r\n]\\)" str)
2176           (let ((major (match-string 1 str)))
2177             (when (string-match "API minor:[ \t]*\\(.*[^ \t\r\n]\\)" str)
2178               (push (list 'api (format "%s.%s"
2179                                        major
2180                                        (match-string 1 str)))
2181                     ret))))
2182         ret))))
2183
2184 ;;; ----------------------------------------------------------------------
2185 ;;;
2186 (defun tinycygwin-sysinfo-os-cygwin-dll-version-string  ()
2187   "Make DLL version information string."
2188   (let* ((info (tinycygwin-sysinfo-os-cygwin-dll-info)))
2189     (when info
2190       (let* ((ver (nth 1 (assq 'version info)))
2191              (api (nth 1 (assq 'api info)))
2192              (cvs (nth 1 (assq 'cvs-tag info))))
2193         (concat
2194          (if ver
2195              ver
2196            "")
2197          (if api
2198              (concat " api " api)
2199            "")
2200          (if cvs
2201              (concat " cvs " cvs))
2202          " (cygwin1.dll)")))))
2203
2204 ;;; ----------------------------------------------------------------------
2205 ;;;
2206 (defsubst tinycygwin-sysinfo-os-cygwin ()
2207   "Return Cygwin OS information."
2208   (tinycygwin-sysinfo-os-cygwin-dll-version-string))
2209
2210 ;;}}}
2211 ;;{{{ Cygwin Packages
2212
2213 ;;; ----------------------------------------------------------------------
2214 ;;;
2215 (defun tinycygwin-package-buffer (package &optional load)
2216   "Return buffer for PACKAGE. Optionally LOAD to Emacs if no buffer found."
2217   (tinycygwin-file-buffer
2218    (tinycygwin-package-info-path-doc-cygwin-package package)))
2219
2220 ;;; ----------------------------------------------------------------------
2221 ;;;
2222 (put 'tinycygwin-package-buffer-with 'edebug-form-spec '(body))
2223 (put 'tinycygwin-package-buffer-with 'lisp-indent-function 1)
2224 (defmacro tinycygwin-package-buffer-with (package &rest body)
2225   "In Cygwin documentation buffer for PACKAGE, run BODY."
2226   `(let* ((buffer (tinycygwin-package-buffer package)))
2227      (when buffer
2228        (with-current-buffer buffer
2229          ,@body))))
2230
2231 ;;; ----------------------------------------------------------------------
2232 ;;;
2233 (put 'tinycygwin-package-buffer-search 'lisp-indent-function 2)
2234 (defmacro tinycygwin-package-buffer-search (package regexp &optional subexp)
2235   "Search Cywin PACKAGE documentation for REGEXP and return SUBEXP or 0."
2236   `(progn
2237      (tinycygwin-package-buffer-with package
2238                                      (goto-char (point-min))
2239                                      (when (re-search-forward ,regexp nil t)
2240                                        (match-string (or ,subexp 0))))))
2241
2242 ;;; ----------------------------------------------------------------------
2243 ;;;
2244 (defsubst tinycygwin-package-wnpp-p (package)
2245   "Chekc if PACKAGE is the wnpp presude package."
2246   (and (stringp package)
2247        (string-match "^wnpp" package)))
2248
2249 ;;; ----------------------------------------------------------------------
2250 ;;;
2251 (defsubst tinycygwin-package-pseudo-p (package)
2252   "Chekc if PACKAGE is the generic bug package."
2253   (and (stringp package)
2254        (string-match "^bug-generic" package)))
2255
2256 ;;; ----------------------------------------------------------------------
2257 ;;;
2258 (defsubst tinycygwin-package-itp-p (package)
2259   "Chekc if PACKAGE is ITP, intent to package."
2260   (and (stringp package)
2261        (string-match "^wnpp" package)))
2262
2263 ;;; ----------------------------------------------------------------------
2264 ;;;
2265 (defsubst tinycygwin-package-special-p (package)
2266   "Chekc if PACKAGE is special. I.e. does not exist, but has other meaning."
2267   (and (stringp package)
2268        (or (tinycygwin-package-pseudo-p package)
2269            (tinycygwin-package-wnpp-p package))))
2270
2271 ;;; ----------------------------------------------------------------------
2272 ;;;
2273 (defsubst tinycygwin-package-info-field-1 (field info &optional string-p)
2274   "Return FIELD from INFO, optionally as empty STRING-P."
2275   (if string-p
2276       (or (nth 1 (assoc field info)) "")
2277     (nth 1 (assoc field info))))
2278
2279 ;;; ----------------------------------------------------------------------
2280 ;;;
2281 (defsubst tinycygwin-package-info-field-cdr (field info)
2282   "Return cdr FIELD from INFO."
2283   (cdr-safe (assoc field info)))
2284
2285 ;;; ----------------------------------------------------------------------
2286 ;;;
2287 (defsubst tinycygwin-package-info-field-ignore (info)
2288   "Return the \"Ignore-errors\' field content."
2289   (tinycygwin-package-info-field-1 "Ignore-errors" info))
2290
2291 ;;; ----------------------------------------------------------------------
2292 ;;;
2293 (defsubst tinycygwin-package-info-field-status (info)
2294   "Return the \"Status\' field content."
2295   (tinycygwin-package-info-field-1 "Status" info))
2296
2297 ;;; ----------------------------------------------------------------------
2298 ;;;
2299 (defsubst tinycygwin-package-info-field-package (info)
2300   "Return the \"Package\' field content."
2301   (tinycygwin-package-info-field-1 "Package" info))
2302
2303 ;;; ----------------------------------------------------------------------
2304 ;;;
2305 (defsubst tinycygwin-package-info-field-version (info)
2306   "Return the \"Package\' field content."
2307   (tinycygwin-package-info-field-1 "Version" info))
2308
2309 ;;; ----------------------------------------------------------------------
2310 ;;;
2311 (defsubst tinycygwin-package-info-field-release (info)
2312   "Return the \"Package\' field content."
2313   (tinycygwin-package-info-field-1 "Release" info))
2314
2315 ;;; ----------------------------------------------------------------------
2316 ;;;
2317 (defsubst tinycygwin-package-info-field-name-ok-p (string)
2318   "Return non-nil if STRING is valid package field name."
2319   (not (string-match "^ignore" string)))
2320
2321 ;;; ----------------------------------------------------------------------
2322 ;;;
2323 (defun tinycygwin-readme-package-file-list (&optional regexp)
2324   "Return ist of absolute paths to <package>.README or REGEXP files."
2325   (let ((dir (tinycygwin-path-doc-cygwin))
2326         ret)
2327     (when (and dir
2328                (file-directory-p dir))
2329       (directory-files
2330        dir
2331        'absolute
2332        regexp))))
2333
2334 ;;; ----------------------------------------------------------------------
2335 ;;;
2336 (defun tinycygwin-readme-package-name-list (&optional add-list)
2337   "Return list of all installed packages in `tinycygwin-path-doc-cygwin'.
2338 Optinally add ADD-LIST to the returned list."
2339   (let (name
2340         ret)
2341     (dolist (file (tinycygwin-readme-package-file-list "\\.README"))
2342       (setq name (replace-regexp-in-string
2343                   ;;  Not all package have version number
2344                   ;;  => cygserver.README
2345                   "\\(-[0-9].*\\)\\|\\.README.*"
2346                   ""
2347                   (file-name-nondirectory file)))
2348       (push name ret))
2349     (if add-list
2350         (setq ret (append add-list ret)))
2351     ret))
2352
2353 ;;; ----------------------------------------------------------------------
2354 ;;;
2355 (defun tinycygwin-install-database-buffer ()
2356   "Return `tinycygwin-:file-install-db' buffer."
2357   (tinycygwin-file-buffer tinycygwin-:file-install-db))
2358
2359 ;;; ----------------------------------------------------------------------
2360 ;;;
2361 (put 'tinycygwin-install-database-buffer-with 'lisp-indent-function 0)
2362 (defmacro tinycygwin-install-database-buffer-with (&rest body)
2363   "Run BODY in `tinycygwin-:file-install-db' buffer."
2364   `(let ((buffer (tinycygwin-install-database-buffer)))
2365      (when buffer
2366        (with-current-buffer buffer
2367          ,@body))))
2368
2369 ;;; ----------------------------------------------------------------------
2370 ;;;
2371 (defun tinycygwin-database-buffer-insert ()
2372   "Insert `tinycygwin-:file-install-db'."
2373   (let* ((file (tinycygwin-path tinycygwin-:file-install-db)))
2374     (if (file-exists-p file)
2375         (insert-file-contents file)
2376       (message "TinyCygwin: Not found %s" file))))
2377
2378 ;;; ----------------------------------------------------------------------
2379 ;;;
2380 (defun tinycygwin-database-buffer-package-info (package)
2381   "Return PACKAGE install.db information."
2382   (tinycygwin-install-database-buffer-with
2383    (let* ((case-fold-search t)
2384           (regexp (format "^%s +.+" package)))
2385      (goto-char (point-min))
2386      (when (re-search-forward regexp nil t)
2387        (match-string 0)))))
2388
2389 ;;; ----------------------------------------------------------------------
2390 ;;;
2391 (defun tinycygwin-database-buffer-package-list ()
2392   "Return list of installed packages"
2393   (tinycygwin-install-database-buffer-with
2394    (let (list)
2395      (goto-char (point-min))
2396      (search-forward "INSTALLED.DB" nil t) ;; Skip this
2397      (while (re-search-forward "^[^ \t\r\n]+" nil t)
2398        (push (match-string 0) list))
2399      list)))
2400
2401 ;;; ----------------------------------------------------------------------
2402 ;;;
2403 (defun tinycygwin-package-info-string-split (string)
2404   "Return package, version, release from STRING like foo-1.2.0-1.tar.bz2."
2405   (when (or (string-match
2406              ;; foo-1.2.0-1.tar.bz2
2407              "^\\([a-z-]+[0-9]?\\)-\\([0-9]+[0-9.-]*[0-9]\\)-\\(.+\\)"
2408              string)
2409             (string-match
2410              ;; libxxx1-1.3-2
2411              "^\\([a-z-]+[0-9]?\\)-\\([0-9]+[0-9.-]*[0-9]\\)\\(.*\\)"
2412              string)
2413             ;; a2ps-4.13
2414             (string-match
2415              "^\\([a-z0-9]+[0-9]?\\)-\\([0-9]+[0-9.-]*[0-9]\\)\\(.*\\)"
2416              string))
2417     (let* ((name (match-string 1 string))
2418            (ver  (match-string 2 string))
2419            rel)
2420       (setq string (match-string 3 string)) ;; The rest
2421       ;;  Release cannot be more than 2 numbers.
2422       (when (string-match "^\\([0-9][0-9]?\\)\\([^0-9]+\\|$\\)" string)
2423         (setq rel (match-string 1 string)))
2424       (list name ver rel))))
2425
2426 ;;; ----------------------------------------------------------------------
2427 ;;;
2428 (defun tinycygwin-package-info-string-package (string)
2429   "Return version from STRING."
2430   (nth 0 (tinycygwin-package-info-string-split string)))
2431
2432 ;;; ----------------------------------------------------------------------
2433 ;;;
2434 (defun tinycygwin-package-info-string-version (string)
2435   "Return version from STRING."
2436   (nth 1 (tinycygwin-package-info-string-split string)))
2437
2438 ;;; ----------------------------------------------------------------------
2439 ;;;
2440 (defun tinycygwin-package-info-string-release (string)
2441   "Return release number from STRING."
2442   (nth 2 (tinycygwin-package-info-string-split string)))
2443
2444 ;;; ----------------------------------------------------------------------
2445 ;;;
2446 (defun tinycygwin-package-info-path-doc-cygwin (string)
2447   "Return Cygwin documentation file path for STRING like foo-1.2.0-1.tar.bz2."
2448   (multiple-value-bind (package version release)
2449       (tinycygwin-package-info-string-split string)
2450     (if (not version)
2451         (message "TinyCygwin: Can't parse doc dir from %s" string)
2452       (setq release release) ;; Byte compiler silencer
2453       (let ((dir (tinycygwin-path-doc-root)))
2454         (format "%s/Cygwin/%s-%s.README" dir package version)))))
2455
2456 ;;; ----------------------------------------------------------------------
2457 ;;;
2458 (defun tinycygwin-package-info-path-doc-cygwin-package (package)
2459   "Return Cygwin documentation file path for PACKAGE like 'foo'."
2460   (let ((dir (tinycygwin-path-doc-cygwin)))
2461     (when (and dir
2462                (file-directory-p dir))
2463       (let ((list (directory-files
2464                    dir
2465                    'absolute
2466                    (format "^%s-.*README" package))))
2467         (when (eq (length list) 1)
2468           (car list))))))
2469
2470 ;;; ----------------------------------------------------------------------
2471 ;;;
2472 (defun tinycygwin-package-info-name (package)
2473   "Return PACKAGE name from `tinycygwin-:path-doc-cygwin-list'.
2474 This is ismilar function to `tinycygwin-database-buffer-package-info'."
2475   (let* ((file (tinycygwin-package-info-path-doc-cygwin-package package)))
2476     (when file
2477       (replace-regexp-in-string
2478        "\\.README"
2479        ""
2480        (file-name-nondirectory file)))))
2481
2482 ;;; ----------------------------------------------------------------------
2483 ;;;
2484 (defun tinycygwin-package-info-port-maintainer-1 ()
2485   "Search current buffer for maintainer."
2486   (goto-char (point-min))
2487   (or (and (re-search-forward
2488             "Cygwin port.*maintained.*:[ \t]*\\(.+[^ \t\r\n]\\)" nil t)
2489            (match-string 1))
2490       (progn
2491         (goto-char (point-max))
2492         (when (search-backward "@" nil t)
2493           (cond
2494            ((search-backward ":" (line-beginning-position) t)
2495             ;; Maintainer: ...
2496             (re-search-forward "[: \t]+" nil t)
2497             (buffer-substring (point) (line-end-position)))
2498            (t
2499             (goto-char (line-beginning-position))
2500             (if (looking-at "[ \t]*\\(.+@.+[^ \t\r\n]\\)")
2501                 (match-string 1))))))))
2502
2503 ;;; ----------------------------------------------------------------------
2504 ;;;
2505 (defun tinycygwin-package-info-port-maintainer (package)
2506   "Return Cygwin port maintainer for PACKAGE."
2507   (tinycygwin-package-buffer-with package
2508                                   (tinycygwin-package-info-port-maintainer-1)))
2509
2510 ;;; ----------------------------------------------------------------------
2511 ;;;
2512 (defun tinycygwin-package-info-bug-report (package)
2513   "Return bug report address for PACKAGE"
2514   (let* ((upstream-info
2515           (tinycygwin-package-info-upstream-contacts package))
2516          (str (if upstream-info
2517                   (nth 1 (assq 'bugs upstream-info)))))
2518     str))
2519
2520 ;;; ----------------------------------------------------------------------
2521 ;;;
2522 (defun tinycygwin-package-info-maintainer (package)
2523   "Return author or maintainer of the PACKAGE."
2524   (let* ((upstream-info
2525           (tinycygwin-package-info-upstream-contacts package))
2526          (str (if upstream-info
2527                   (nth 1 (or (assq 'maintainer upstream-info)
2528                              (assq 'author upstream-info))))))
2529     str))
2530
2531 ;;; ----------------------------------------------------------------------
2532 ;;;
2533 (put 'tinycygwin-package-info-macro 'lisp-indent-function 2)
2534 (defmacro tinycygwin-package-info-macro (package check-variable &rest body)
2535   "PACKAGE. If CHECK-VARIABLE is set, then allow running BODY."
2536   `(let ((special (tinycygwin-package-special-p package)))
2537      (when (and
2538             (not special)
2539             ,check-variable)
2540        ,@body)))
2541
2542 ;;; ----------------------------------------------------------------------
2543 ;;;
2544 (defun tinycygwin-package-info-port-maintainer-maybe (package)
2545   "Only in certain conditions return package mailtainer's email aadress.
2546 PACKAGE is not special and
2547 `tinycygwin-:package-maintainer-email-include' is set."
2548   (tinycygwin-package-info-macro
2549    package tinycygwin-:package-maintainer-email-include
2550    (tinycygwin-package-info-port-maintainer package)))
2551
2552 ;;; ----------------------------------------------------------------------
2553 ;;;
2554 (defun tinycygwin-package-info-maintainer-maybe (package)
2555   "Only in certain conditions return package mailtainer's email aadress.
2556 PACKAGE is not special and
2557 `tinycygwin-:package-maintainer-email-include' is set."
2558   (tinycygwin-package-info-macro
2559    package tinycygwin-:package-upstream-email-include
2560    (tinycygwin-package-info-port-maintainer package)))
2561
2562 ;;; ----------------------------------------------------------------------
2563 ;;;
2564 ;;;###autoload
2565 (defun tinycygwin-package-info-port-maintainer-list (&optional display)
2566   "Generate list of all packages and their maintainers. Optionally DISPLAY."
2567   (interactive (list t))
2568   (let* ((buffer (get-buffer-create
2569                   tinycygwin-:buffer-maintainer-list))
2570          (dir    (tinycygwin-path-doc-cygwin))
2571          package
2572          maintainer)
2573     (with-current-buffer buffer
2574       (erase-buffer))
2575     (with-temp-buffer
2576       (dolist (file (directory-files dir 'abs "\\.README$"))
2577         (erase-buffer)
2578         (insert-file-contents-literally file)
2579         (setq maintainer
2580               (or (tinycygwin-package-info-port-maintainer-1)
2581                   "ERROR, not found; file syntax unknown"))
2582         (with-current-buffer buffer
2583           (goto-char (point-max))
2584           (insert (format "%-30s %s\n"
2585                           (replace-regexp-in-string
2586                            "\\.README"
2587                            ""
2588                            (file-name-nondirectory file))
2589                           maintainer)))))
2590     (if display
2591         (pop-to-buffer buffer))
2592     buffer))
2593
2594 ;;; ----------------------------------------------------------------------
2595 ;;;
2596 (defun tinycygwin-package-info-homepage (package)
2597   "Return homepage of PACKAGE."
2598   (tinycygwin-package-buffer-search
2599    package
2600    ".*homepage:[ \t\r\n]*\\(.+[^ \t\r\n]\\)"
2601    1))
2602
2603 ;;; ----------------------------------------------------------------------
2604 ;;;
2605 (defsubst tinycygwin-package-info-heading-block (package heading)
2606   "Return Heading: block for Cygwin PACKAGE documentation."
2607   (tinycygwin-package-buffer-search
2608    package
2609    ;;  Grab all indented lines after HEADING
2610    (format  "%s.*\\(\r?\n[ \t]+.*\\)+" heading)
2611    0))
2612
2613 ;;; ----------------------------------------------------------------------
2614 ;;;
2615 (defun tinycygwin-package-info-heading-value
2616   (package heading header &optional subexp)
2617   "Read PACKAGE and position to HEADING regexp and read HEADER SUBEXP
2618 Like if HEADER were 'Upstream contact' and HEADING were
2619 'Author: +\(.+\)' from text:
2620
2621     Upstream contact:
2622       Author: Foo Bar <foo@example.com>
2623       Bugs: Foo Bar <foo@example.com>"
2624   (let ((str (tinycygwin-package-info-heading-block
2625               package
2626               heading)))
2627     (when str
2628       (with-temp-buffer
2629         (insert str)
2630         (goto-char (point-min))
2631         (goto-char (line-end-position)) ;; Past heading
2632         (when (re-search-forward header nil t)
2633           (match-string (or subexp 0)))))))
2634
2635 ;;; ----------------------------------------------------------------------
2636 ;;;
2637 (defun tinycygwin-package-info-first-email (package)
2638   "Return first email address from PACKAGE."
2639   (tinycygwin-package-buffer-search
2640    package
2641    "[^: \t\r\n][^:@\r\n]+@.+[^ \t\r\n]"
2642    0))
2643
2644 ;;; ----------------------------------------------------------------------
2645 ;;;
2646 (defun tinycygwin-package-info-upstream-contacts (package)
2647   "Return upstream contact addresses.
2648
2649 Return:
2650
2651   '((author address)
2652     (bugs   address))
2653
2654 Notice that the values may be missing if no such fields were found."
2655   (let ((fields
2656          '((bugs       "Bugs:[ \t]*\\(.+\\)")
2657            (maintainer "Maintainer:[ \t]*\\(.+\\)")
2658            (author     "Author:[ \t]*\\(.+\\)")))
2659         ret
2660         val)
2661     (dolist (elt fields)
2662       (multiple-value-bind (tag regexp) elt
2663         (when (setq val
2664                     (tinycygwin-package-info-heading-value
2665                      package
2666                      "^upstream"
2667                      regexp
2668                      1))
2669           (push (list tag val) ret))))
2670     ret))
2671
2672 ;;; ----------------------------------------------------------------------
2673 ;;;
2674 (defun tinycygwin-package-status-cygwin (package)
2675   "Return Cygwin PACKAGE details.
2676 '((\"Package\" \"foo\")
2677    (\"Status\"  \"installed\")
2678    (\"Version\" \"1.13\")
2679    (\"Release\" \"1\")
2680    ...)"
2681   (let* ((db     (tinycygwin-database-buffer-package-info package))
2682          (cygdoc (unless db
2683                    (tinycygwin-package-info-name package)))
2684          version
2685          release
2686          ret)
2687     (flet ((push-ret (tag value function)
2688                      (when (and value
2689                                 (setq value (funcall function value)))
2690                        (push (list tag value) ret))))
2691       (cond
2692        ((not (or db cygdoc))
2693         (setq ret
2694               (list
2695                (list "Package" package)
2696                (list "Status" "not-installed"))))
2697        (db
2698         ;; keychain keychain-1.9-1.tar.bz2 0
2699         (multiple-value-bind (name package dummy)
2700             (split-string db)
2701           (setq ret
2702                 (list (list "Package" name)
2703                       (list "Name"    package)
2704                       (list "Status"  "installed")))
2705           (push-ret "Version"
2706                     package
2707                     'tinycygwin-package-info-string-version)
2708           (push-ret "Release"
2709                     package
2710                     'tinycygwin-package-info-string-release)))
2711        (cygdoc
2712         (setq ret
2713               (list
2714                (list "Package" (replace-regexp-in-string
2715                                 "-[0-9].*"
2716                                 ""
2717                                 package))
2718                (list "Name"    cygdoc)
2719                (list "Status" "installed-3rd-party")))
2720         (push-ret "Version"
2721                   cygdoc
2722                   'tinycygwin-package-info-string-version)
2723         (push-ret "Release"
2724                   cygdoc
2725                   'tinycygwin-package-info-string-release)))
2726       (tinycygwin-debug
2727        (message "TinyCygwin: [DEBUG] pkg-status-cygwin '%s'"
2728                 (prin1-to-string ret)))
2729       ret)))
2730
2731 ;;; ----------------------------------------------------------------------
2732 ;;;
2733 (defsubst tinycygwin-package-status-bug-generic ()
2734   "Return Generic bug package status values."
2735   '(("Package" "")
2736     ("Status" "")
2737     ("Ignore-errors" "files email")))
2738
2739 ;;; ----------------------------------------------------------------------
2740 ;;;
2741 (defsubst tinycygwin-package-status-wnpp ()
2742   "Return WNPP package status values."
2743   '(("Package" "wnpp")
2744     ("Ignore-errors" "files email")))
2745
2746 ;;; ----------------------------------------------------------------------
2747 ;;;
2748 (defun tinycygwin-package-status-main (package)
2749   "Return PACKAGE details.
2750
2751 One PACKAGE name is special: \"bug-generic\".
2752
2753 This package does not exist, but informas, that you want to fill in a
2754 genereic bug report concerning issues in Cygwin. If you're porting
2755 software to Cygwin, but can't get it cmpiled, you may want to talk
2756 o the author of the code. Creating a generic bug report, help you and the
2757 author to keep track of discussion."
2758   (cond
2759    ((tinycygwin-package-pseudo-p package)
2760     (tinycygwin-package-status-bug-generic))
2761    ((tinycygwin-package-wnpp-p package)
2762     (tinycygwin-package-status-wnpp))
2763    (t
2764     (tinycygwin-package-status-cygwin package))))
2765
2766 ;;; ----------------------------------------------------------------------
2767 ;;;
2768 (defun tinycygwin-package-read-name (&optional prompt list add-list)
2769   "Read installed package name with optional PROMPT.
2770 The optional LIST is full ask lisk. ADD-LIST is added to the default
2771 package ask list."
2772   (message "Wait, building package list...")
2773   (completing-read
2774    (or prompt
2775        "Cygwin package name (TAB to complete): ")
2776    (mapcar (lambda (x)
2777              (cons x 'dummy))
2778            (or list
2779                ;; tinycygwin-database-buffer-package-list
2780                (tinycygwin-readme-package-name-list add-list)))
2781    nil
2782    'match))
2783
2784 ;;; ----------------------------------------------------------------------
2785 ;;;
2786 ;;;###autoload
2787 (defun tinycygwin-package-readme-find-file (package)
2788   "Open PACKAGE*.README."
2789   (interactive
2790    (list (tinycygwin-package-read-name
2791           "Find File (Cygwin package README): ")))
2792   (when package
2793     (let ((file (tinycygwin-package-info-path-doc-cygwin-package
2794                  package)))
2795       (unless file
2796         (error "TinyCygwin: [ERROR] Cannot find %s*.README"
2797                package))
2798       (find-file file))))
2799
2800 ;;; ----------------------------------------------------------------------
2801 ;;;
2802 (defun tinycygwin-package-info-main (package)
2803   "Get PACKAGE information. See`tinycygwin-package-status'."
2804   (when (stringp package)
2805     (tinycygwin-string-trim package)
2806     (when (string-match "[^ \t\r\n]" package)
2807       (tinycygwin-package-status-main package))))
2808
2809 ;;}}}
2810 ;;{{{ Bug reporting interface
2811
2812 ;;; ----------------------------------------------------------------------
2813 ;;;
2814 (defsubst tinycygwin-bug-type-standard-p (type)
2815   "Check if bug TYPE is standard bug."
2816   (or (null type)
2817       (and (stringp type)
2818            (string= "standard" type))))
2819
2820 ;;; ----------------------------------------------------------------------
2821 ;;;
2822 (defun tinycygwin-bug-system-info-os-architecture ()
2823   "Read architecture."
2824   (cond
2825    ((eq tinycygwin-:os-type 'cygwin)
2826     (tinycygwin-sysinfo-os-cygwin))
2827    ((eq tinycygwin-:os-type 'linux)
2828     (tinycygwin-sysinfo-os-linux-arch))))
2829
2830 ;;; ----------------------------------------------------------------------
2831 ;;;
2832 (defun tinycygwin-bug-system-info-os-version ()
2833   "Read Cygwin version number."
2834   (cond
2835    ((eq tinycygwin-:os-type 'cygwin)
2836     (tinycygwin-sysinfo-os-windows))
2837    ((eq tinycygwin-:os-type 'linux)
2838     (tinycygwin-sysinfo-os-kernel-version))))
2839
2840 ;;; ----------------------------------------------------------------------
2841 ;;;
2842 (defun tinycygwin-bug-system-info-locale ()
2843   "Get locale information."
2844   (let* ((list
2845           '("LC_ALL"
2846             "LC_CTYPE"))
2847          val
2848          ret)
2849     (dolist (var list)
2850       (when (setq val (getenv var))
2851         (setq val (format "%s=%s" var val))
2852         (setq ret (if (null ret)
2853                       val
2854                     (concat ret ", " val)))))
2855     ret))
2856
2857 ;;; ----------------------------------------------------------------------
2858 ;;;
2859 (defun tinycygwin-bug-system-info-os-main ()
2860   "Return OS information. Something like below.
2861 Release: 1.5.7
2862 Architecture: i386
2863 Kernel:
2864 Locale: LANG=en_US, LC_CTYPE=en_US."
2865   (let ((kernel   (tinycygwin-bug-system-info-os-architecture))
2866         (release  (tinycygwin-bug-system-info-os-version))
2867         (locale   (tinycygwin-bug-system-info-locale)))
2868     (format "\
2869 Release: %s
2870 Kernel: %s
2871 Locale: %s
2872 "
2873             (or release "")
2874             (or kernel  "")
2875             (or locale  ""))))
2876
2877 ;;; ----------------------------------------------------------------------
2878 ;;;
2879 (defun tinycygwin-bug-severity ()
2880   "Select bug severity."
2881   (setq tinycygwin-:menu-severity-selected nil)
2882   (while (null tinycygwin-:menu-severity-selected)
2883     (ti::menu-menu 'tinycygwin-:menu-severity)
2884     (unless tinycygwin-:menu-severity-selected
2885       (message "TinyCygwin: Please select severity.")
2886       (sit-for 1)))
2887   tinycygwin-:menu-severity-selected)
2888
2889 ;;; ----------------------------------------------------------------------
2890 ;;;
2891 (defun tinycygwin-bug-report-exit ()
2892   "Ask to exit Emacs unless `tinycygwin-:expert-flag' is non-nil."
2893   (tinycygwin-non-expert-with
2894    (tinycygwin-external-with
2895     (when (y-or-n-p "Exit Emacs now? ")
2896       (kill-emacs)))))
2897
2898 ;;; ----------------------------------------------------------------------
2899 ;;;
2900 (defun tinycygwin-bug-report-mail-attach-file (file)
2901   "Attach file \"as is\" to current point."
2902   (unless (bolp)
2903     (beginning-of-line))
2904   (unless (looking-at "^[ \t]*$")
2905     (insert "\n"))
2906   (insert (format "\n%s\n" (tinycygwin-mail-attachment-tag file)))
2907   (tinycygwin-not-modified-with
2908    (insert-file-contents-literally file)))
2909
2910 ;;; ----------------------------------------------------------------------
2911 ;;;
2912 (defun tinycygwin-bug-report-mail-insert-files (list &optional type)
2913   "Attach LIST of file to the end of current buffer.
2914
2915 Optional TYPE
2916
2917   'as-is        Add as plain text.
2918   'mime         Add as a mime attachment.
2919   nil           Ask user wat to do with files that are not binaries."
2920   (when list
2921     (unless (eq major-mode 'message-mode)
2922       (error
2923        "TinyCygwin: Can't add attachments. Not in `message-mode'"))
2924     (let (mml-type
2925           description)
2926       (goto-char (point-max))
2927       (tinycygwin-not-modified-with
2928        (insert "\n"))
2929       (dolist (file list)
2930         (goto-char (point-max))
2931         (cond
2932          ((not (file-exists-p file))
2933           (let ((msg (format "[ERROR] Not exists. Can't attach file %s "
2934                              file)))
2935             (message msg)
2936             (tinycygwin-non-expert-with
2937              (sit-for 2))))
2938          ((tinycygwin-file-binary-p file)
2939           (mml-attach-file file type description))
2940          ((or (eq type 'mime)
2941               (and (null type)
2942                    (y-or-n-p
2943                     (format "Insert as a MIME attachment/as is [%s]? "
2944                             (file-name-nondirectory file)))))
2945           (tinycygwin-expert-with
2946            (setq mml-type (mml-minibuffer-read-type file)))
2947           (mml-attach-file file mml-type description))
2948          (t
2949           (tinycygwin-bug-report-mail-attach-file file)))))))
2950
2951 ;;; ----------------------------------------------------------------------
2952 ;;;
2953 (defun tinycygwin-bug-report-mail-insert-details-bundle ()
2954   "Include `tinycygwin-sysinfo-bundle-item' details."
2955   (let (done
2956         info)
2957     (dolist (bundle '(devel-tools lang))
2958       (when (setq info
2959                   (mapconcat (lambda (x)
2960                                (multiple-value-bind (bin ver) x
2961                                  (format "%s %s" bin ver)))
2962                              (tinycygwin-sysinfo-bundle-item
2963                               bundle (not (eq tinycygwin-:os-type 'cygwin)))
2964                              ", "))
2965         (unless done
2966           (insert "\n-- Other package information\n")
2967           (setq done t))
2968         (insert (format "Info-Pkg-%s: %s\n"
2969                         (symbol-name bundle)
2970                         info))))))
2971
2972 ;;; ----------------------------------------------------------------------
2973 ;;;
2974 (defun tinycygwin-bug-report-mail-insert-environment ()
2975   "Insert details from `tinycygwin-:sysinfo-environment-list'"
2976   (let (done
2977         info)
2978     (dolist (var tinycygwin-:sysinfo-environment-list)
2979       (unless done
2980         (insert "\n-- Environment information\n")
2981         (setq done t))
2982       (when (setq info (getenv var))
2983         (insert (format "%s: %s\n" var info))))))
2984
2985 ;;; ----------------------------------------------------------------------
2986 ;;;
2987 (defun tinycygwin-bug-report-mail-insert-details-upstream (package)
2988   "Insert PACKAGE upstream information at point."
2989   (when package
2990     (let ((upstream-info
2991            (tinycygwin-package-info-upstream-contacts package)))
2992       (dolist (info upstream-info)
2993         (multiple-value-bind (type email) info
2994           (insert (format "Upstream-%s: %s"
2995                           (symbol-name type)
2996                           email)))))))
2997
2998 ;;; ----------------------------------------------------------------------
2999 ;;;
3000 (defun tinycygwin-bug-report-mail-insert-details-sysinfo ()
3001   "Insert system information at point."
3002   (insert "\n\n-- System Information\n"
3003           (tinycygwin-bug-system-info-os-main))
3004   (tinycygwin-bug-report-mail-insert-details-bundle))
3005
3006 ;;; ----------------------------------------------------------------------
3007 ;;;
3008 (defun tinycygwin-bug-report-mail-insert-details-package
3009   (info &optional severity)
3010   "Insert package INFO details with optional bug SEVERITY level."
3011   (goto-char (point-min))
3012   (tinycygwin-goto-mail-header-separator)
3013   (let* ((status  (tinycygwin-package-info-field-status  info))
3014          (package (tinycygwin-package-info-field-package info))
3015          (version (tinycygwin-package-info-field-version info))
3016          (release (tinycygwin-package-info-field-release info)))
3017     (dolist (elt (list
3018                   (list "Package"   package)
3019                   (list "Version"   (concat
3020                                      version
3021                                      (if release
3022                                          (concat "-" release)
3023                                        "")))
3024                   (list "Status"    status)
3025                   (list "Severity" (or severity "normal"))))
3026       (multiple-value-bind (field value) elt
3027         (insert (format "%s: %s\n"   field (or value "")))))))
3028
3029 ;;; ----------------------------------------------------------------------
3030 ;;;
3031 (defun tinycygwin-bug-report-mail-insert-details-main
3032   (info &optional severity)
3033   "Insert Details for package INFO with optional bug SEVERITY level."
3034   (tinycygwin-bug-report-mail-insert-details-package info severity)
3035   (tinycygwin-bug-report-mail-insert-details-sysinfo)
3036   (tinycygwin-bug-report-mail-insert-environment)
3037   (tinycygwin-bug-report-mail-insert-details-upstream
3038    (cadr (assoc "Package" info))))
3039
3040 ;;; ----------------------------------------------------------------------
3041 ;;;
3042 (defsubst tinycygwin-bug-report-message-mark-external ()
3043   "Define `tinycygwin-:external-call-flag' local to buffer."
3044   (when tinycygwin-:external-call-flag
3045     (set (make-local-variable 'tinycygwin-:external-call-flag)
3046          tinycygwin-:external-call-flag)))
3047
3048 ;;; ----------------------------------------------------------------------
3049 ;;;
3050 (defun tinycygwin-bug-report-message-send-actions ()
3051   "Arrange `message-send-actions'."
3052   ;;  Will be buffer local. See message.el
3053   (when (boundp 'message-send-actions)
3054     (push '(progn
3055              (message "Bug report sent. %s"
3056                       (or (tinycygwin-external-with
3057                            (tinycygwin-msg-exit-emacs))
3058                           "")))
3059           message-send-actions)))
3060
3061 ;;; ----------------------------------------------------------------------
3062 ;;;
3063 (defun tinycygwin-message-mode-font-lock-keywords ()
3064   "Return correct `font-lock-keywords'."
3065   (if (tinycygwin-window-system)
3066       tinycygwin-:message-mode-font-lock-keywords-window-system
3067     tinycygwin-:message-mode-font-lock-keywords-non-window-system))
3068
3069 ;;; ----------------------------------------------------------------------
3070 ;;;
3071 (defun tinycygwin-bug-report-mail-mode-font-lock ()
3072   "Activate `font-lock-mode' with custom settings."
3073   (let ((keys (tinycygwin-message-mode-font-lock-keywords)))
3074     (when (fboundp 'font-lock-mode)
3075       (when (and (boundp 'message-font-lock-keywords)
3076                  (null (get 'message-mode
3077                             'tinycygwin-font-lock-keywords)))
3078         (require 'font-lock) ;; force to define variables
3079         (tinycygwin-message-mode-faces)
3080         (unless tinycygwin-:original-font-lock-keywords
3081           (set (make-local-variable 'tinycygwin-:original-font-lock-keywords)
3082                font-lock-keywords))
3083         (make-local-variable 'message-font-lock-keywords)
3084         (setq message-font-lock-keywords
3085               (append message-font-lock-keywords keys))
3086         ;;  Delete "Catch all" header regexp whic overrides all other
3087         ;;  faces.
3088         ;;  ("^\\([A-Z][^: \n      ]+:\\)..."
3089         ;;    (1 'message-header-name-face)
3090         ;;    (2 'message-header-other-face nil t))
3091         (setq
3092          message-font-lock-keywords
3093          (delete-if (lambda (x)
3094                       (let* ((str (prin1-to-string x))
3095                              (status
3096                               (string-match
3097                                "other-face\\|cited-text" str)))
3098                         status))
3099                     message-font-lock-keywords))
3100         ;; (put 'message-mode
3101         ;;      'font-lock-defaults
3102         ;;      '(message-font-lock-keywords t))
3103         (put 'message-mode
3104              'tinycygwin-font-lock-keywords
3105              keys))
3106       (font-lock-mode 1))))
3107
3108 ;;; ----------------------------------------------------------------------
3109 ;;;
3110 (defun tinycygwin-bug-report-mail-mode ()
3111   "Turn on mail mode for current buffer."
3112   (set (make-local-variable 'message-cite-prefix-regexp)
3113        "^\\([|>] *\\)+")
3114   (message-mode)
3115   (tinycygwin-non-expert-with
3116    (tinycygwin-bug-report-mail-mode-font-lock))
3117   (tinycygwin-external-with
3118    (tinycygwin-bug-report-message-send-actions))
3119   (auto-save-mode -1)
3120   (when buffer-file-name
3121     ;;  Under windows, file #*message*# is invalid, change it.
3122     (setq buffer-file-name
3123           (replace-regexp-in-string "[*]" "" buffer-file-name))
3124     ;;  Check for working Emacs/Gnus, if not, then cancel save file name
3125     (let ((dir (file-name-directory buffer-file-name)))
3126       (unless (file-directory-p dir)
3127         (message-disassociate-draft)
3128         (setq buffer-file-name nil)))))
3129
3130 ;;; ----------------------------------------------------------------------
3131 ;;;
3132 (defun tinycygwin-bug-report-mail-body-header-value (header)
3133   "Return HEADER value from body of email."
3134   (save-current-buffer
3135     (tinycygwin-goto-mail-header-separator)
3136     (when (re-search-forward
3137            (format
3138             "^%s:[ \t]*\\([^ \t\r\n]+\\)" header)
3139            nil t)
3140       (match-string 1))))
3141
3142 ;;; ----------------------------------------------------------------------
3143 ;;;
3144 (defsubst tinycygwin-bug-high-priority-p (severity)
3145   "Check SEVERITY is high priority (Severity > important)."
3146   (and (stringp severity)
3147        (string-match "critical\\|grave\\|serious" severity)))
3148
3149 ;;; ----------------------------------------------------------------------
3150 ;;;
3151 (defsubst tinycygwin-bug-mail-attached-patch-p ()
3152   "Check if Patch has been attached."
3153   (save-current-buffer
3154     (tinycygwin-goto-mail-header-separator)
3155     (re-search-forward
3156      "\\(attachment:\\|filename=\\).*.\\(diff\\|patch\\)"
3157      nil t)))
3158
3159 ;;; ----------------------------------------------------------------------
3160 ;;;
3161 (defun tinycygwin-bug-report-mail-mode-subject-tags ()
3162   "Add subject tags [patch] etc. if needed"
3163   (let* (value
3164          tag)
3165     (save-current-buffer
3166       (when (and (setq value (tinycygwin-bug-report-mail-body-header-value
3167                               "Severity"))
3168                  (tinycygwin-bug-high-priority-p value))
3169         (setq tag (format "[%s]" value)))
3170       (when (tinycygwin-bug-mail-attached-patch-p)
3171         (setq tag (concat (or tag "")  "[patch]"))))
3172     tag))
3173
3174 ;;; ----------------------------------------------------------------------
3175 ;;;
3176 (defun tinycygwin-bug-report-mail-mode-subject-split (str)
3177   "Split subject STR on ':' or if it does not exist return BUG ID."
3178   (when (stringp str)
3179     (let* (prefix
3180            rest
3181            list)
3182       (cond
3183        ((and (string-match ":" str)
3184              (setq list (split-string str ":")))
3185         (setq prefix (pop list)
3186               rest   (mapconcat 'identity list " ")))
3187        ((string-match "^\\([^#\r\n]+#[0-9T]+\\)\\(.*\\)" str)
3188         (setq prefix (match-string 1 str)
3189               rest   (match-string 2 str))))
3190       (if rest
3191           (list prefix rest)))))
3192
3193 ;;; ----------------------------------------------------------------------
3194 ;;;
3195 (defun tinycygwin-bug-report-mail-mode-set-header (header value)
3196   "Replace HEADER with value."
3197   (save-current-buffer
3198     (goto-char (point-min))
3199     (let ((end "\n"))
3200       (when (re-search-forward
3201              (concat "^" header ":")
3202              nil t)
3203         (delete-region (line-beginning-position) (line-end-position))
3204         (setq end ""))
3205       (insert (format "%s: %s%s" header value end)))))
3206
3207 ;;; ----------------------------------------------------------------------
3208 ;;;
3209 (defun tinycygwin-bug-report-mail-mode-subject-fix ()
3210   "Add tags to subject."
3211   (let ((tag (tinycygwin-bug-report-mail-mode-subject-tags)))
3212     (when tag
3213       ;; message-field-value
3214       (let ((subject (message-fetch-field "Subject")))
3215         (when subject
3216           (multiple-value-bind (prefix rest)
3217               (tinycygwin-bug-report-mail-mode-subject-split subject)
3218             (when (and rest
3219                        ;; Does not have tags already?
3220                        (not (string-match "\\[" rest)))
3221               (tinycygwin-bug-report-mail-mode-set-header
3222                "Subject"
3223                (format "%s: %s%s" prefix tag rest)))))))))
3224
3225 ;;; ----------------------------------------------------------------------
3226 ;;;
3227 (defun tinycygwin-bug-report-mail-subject-compose
3228   (&optional subject package type)
3229   "Compose bug SUBJECT and optionally include PACKAGE name with tYPE."
3230   (format (if package
3231               "%s%s%s"
3232             "%s%s%s")
3233           (tinycygwin-bug-report-email-prefix type)
3234           (if (and (stringp package)
3235                    (not (string= "" package)))
3236               (format " %s: " package)
3237             ": ")
3238           (or subject "")))
3239
3240 ;;; ----------------------------------------------------------------------
3241 ;;;
3242 (defun tinycygwin-bug-report-mail-subject-interactive (&optional package)
3243   "Compose Bug subject. Optional argument PACKAGE is added to Subject."
3244   (let ((subject (or (tinycygwin-non-expert-with
3245                       (read-string "Cygwin bug subject: "))
3246                      "")))
3247     (tinycygwin-bug-report-mail-subject-compose subject package)))
3248
3249 ;;; ----------------------------------------------------------------------
3250 ;;;
3251 (defun tinycygwin-bug-report-mail-compose-email (&optional address-list)
3252   "Compose list of email addresses with optional ADDRESS-LIST."
3253   (let* ((choices       (append
3254                          (tinycygwin-email-choice-list)
3255                          address-list))
3256          (choice-alist  (mapcar (lambda (x)
3257                                   (cons x "dummy"))
3258                                 choices))
3259          list
3260          email)
3261     (while (string-match
3262             "@"
3263             (setq email
3264                   (completing-read
3265                    (format
3266                     "[%d]Bug email (TAB choices; empty to quit): "
3267                     (length list))
3268                    choice-alist)))
3269       (pushnew email list :test 'string=))
3270     (reverse list)))
3271
3272 ;;; ----------------------------------------------------------------------
3273 ;;;
3274 (defun tinycygwin-bug-report-mail-compose-interactive
3275   (buffer to-list package-name info &optional file-list)
3276   "Compose bug report interactively and display BUFFER.
3277 Send mail to TO-LIST with PACKAGE-NAME INFO.
3278 Attach FILE-LIST."
3279   (tinycygwin-pop-to-buffer buffer)
3280   ;;  For inspection in `tinycygwin-bug-report-message-send-actions'.
3281   (tinycygwin-bug-report-message-mark-external)
3282   (erase-buffer)
3283   (let ((subject (tinycygwin-bug-report-mail-subject-interactive
3284                   package-name)))
3285     (tinycygwin-not-modified-with
3286      (tinycygwin-bug-report-mail-compose
3287       to-list
3288       subject)
3289 ;;;     (when info
3290        (message "Please wait, reading sysinfo...")
3291        (goto-char (point-max))
3292        (tinycygwin-bug-report-mail-insert-details-main
3293         info
3294         (tinycygwin-non-expert-with
3295          (tinycygwin-bug-severity)))
3296        (message "Please wait, reading sysinfo... Done.")
3297 ;;;       )
3298      (tinycygwin-bug-report-mail-insert-files file-list)
3299      (tinycygwin-bug-report-mail-mode-finish)))
3300   (run-hooks 'tinycygwin-:bug-report-mail-hook))
3301
3302 ;;; ----------------------------------------------------------------------
3303 ;;;
3304 (defun tinycygwin-bug-report-mail-main-new-bug
3305   (buffer package info &optional email-list file-list)
3306   "Generate new bug report for PACKAGE and with INFO.
3307 Optionally to EMAIL-LIST."
3308   (let ((ignore (tinycygwin-package-info-field-ignore info)))
3309     (setq email-list
3310           (cond
3311            (tinycygwin-:expert-flag
3312             (append email-list
3313                     (tinycygwin-email-choice-list package)))
3314            ((null ignore)
3315             (tinycygwin-bug-report-mail-compose-email
3316              email-list))))
3317     (tinycygwin-bug-report-mail-compose-interactive
3318      buffer
3319      email-list
3320      package
3321      info
3322      file-list)))
3323
3324 ;;; ----------------------------------------------------------------------
3325 ;;;
3326 (defun tinycygwin-bug-report-mail-main-2 (info &optional file-list)
3327   "See `tinycygwin-bug-report-mail-main' for INFO FILE-LIST."
3328   (let* ((status        (tinycygwin-package-info-field-status info))
3329          (ignore        (tinycygwin-package-info-field-ignore info))
3330          (package       (tinycygwin-package-info-field-package info))
3331          (special       (tinycygwin-package-special-p package))
3332          (maintainer    (tinycygwin-package-info-port-maintainer-maybe
3333                          package))
3334          (author        (tinycygwin-package-info-maintainer package))
3335          (name          (tinycygwin-bug-report-email-buffer-name
3336                          package))
3337          email-list)
3338     (tinycygwin-debug
3339      (message "TinyCygwin: [DEBUG] bug-1 pkg %s maintainer %s maint %s"
3340               package maintainer author))
3341     ;; ............................................. no maintainer ...
3342     (when (and package
3343                tinycygwin-:package-maintainer-email-include
3344                (not special)
3345                (not maintainer))
3346       (read-string
3347        (format
3348         (concat
3349          "No maintainer email in %s*.README. "
3350          "Consider reporting this bug as well <RET to continue>.")
3351         package)))
3352     (cond
3353      ;; ...................................... previous bug report ...
3354      ((and (get-buffer name)
3355            (null (y-or-n-p
3356                   "Delete previously composed bug report? ")))
3357       (tinycygwin-pop-to-buffer (get-buffer name)))
3358      ;; ........................................... new bug report ...
3359      (t
3360       (when author
3361         (push (format
3362                "maintainer of the package %s - %s"
3363                (or package "")
3364                (car (tinycygwin-user-mail-address-fix
3365                      (list author))))
3366               email-list))
3367       (when maintainer
3368         (push (format
3369                "Cygwin port maintainer %s - %s"
3370                (or package "")
3371                (car (tinycygwin-user-mail-address-fix
3372                      (list maintainer))))
3373               email-list))
3374       (tinycygwin-bug-report-mail-main-new-bug
3375        (tinycygwin-bug-report-mail-mode-buffer name)
3376        package
3377        info
3378        email-list
3379        file-list)))))
3380
3381 ;;; ----------------------------------------------------------------------
3382 ;;;
3383 (defun tinycygwin-bug-report-mail-type-standard (info &optional file-list)
3384   "INFO is alist of package's attributes.
3385 Optional TYPE is bug type.
3386 FILE-LIST are files to attach.
3387
3388 An example bug report would look something like:
3389
3390     To: <Cygwin package maintainer>
3391     Subject: Cygwin-bug#20040121T1030 foo: <subject of the bug>
3392     --text follows this line--
3393     Package: foo
3394     Version: 0.35-10
3395     Status: installed-3rd-party
3396     Severity: wishlist
3397
3398     <bug report body described here>
3399
3400     -- System Information
3401     Release: 1.5.7 api 0.109 cvs cr-0x9e
3402     Kernel: Windows 2000 Professional Ver 5.0 Build 2195 Sp4
3403     Locale: LC_ALL=en_US
3404
3405     -- Other package information
3406     Info-Pkg-devel-tools: gcc 3.3.1-3, make 3.80-1, libtool 1.5b-1
3407     Info-Pkg-lang: perl 5.8.2-1, python 2.3.3-1, ruby 1.8.1-1
3408
3409     -- Environment information
3410     CYGWIN: tty ntsec binmode smbntsec
3411
3412 For lisp calls, The INFO variables is like:
3413
3414     '((\"Status\" ...)
3415       (\"Package\" ...)
3416       ...)."
3417   (let* ((status        (tinycygwin-package-info-field-status info))
3418          (package       (tinycygwin-package-info-field-package info))
3419          (special       (tinycygwin-package-special-p package)))
3420     (tinycygwin-debug
3421      (message "TinyCygwin: [DEBUG] bug-1 info %s\n"
3422               (prin1-to-string info))
3423      (message "TinyCygwin: [DEBUG] bug-1 package '%s'"
3424               (prin1-to-string package))
3425      (message "TinyCygwin: [DEBUG] bug-1 file-list '%s'"
3426               (prin1-to-string file-list)))
3427     (cond
3428      ((null info)
3429       (message
3430        (format "No package INFO available to send a bug report. %s"
3431                (if (tinycygwin-external-with
3432                     (tinycygwin-msg-exit-emacs))
3433                    ""))))
3434      ((and (not special)
3435            (string-match "not-installed" (or status "")))
3436       (cond
3437        ((y-or-n-p
3438          (format "Packege [%s] is not installed. Select other package? "
3439                  (or package "")))
3440         (let ((package (tinycygwin-package-read-name)))
3441           (when (string-match "[^ \t\r\n]" (or package ""))
3442             ;; Phew, this is recursive call to back to us.
3443             (tinycygwin-bug-report-mail-package package file-list))))
3444        (t
3445         (or (tinycygwin-bug-report-exit)
3446             (tinycygwin-external-with
3447              (message (tinycygwin-msg-exit-emacs)))))))
3448      (t
3449       (tinycygwin-bug-report-mail-main-2 info file-list)))))
3450
3451 ;;; ----------------------------------------------------------------------
3452 ;;;
3453 (defun tinycygwin-bug-report-mail-type-update-xxx-todo (info)
3454   "Request update of package whose INFO is old."
3455   (let* ((status (assoc "Status" info)))
3456     (when status
3457       (setq info (delete status info)))
3458     (push '("Status" "old") info)))
3459
3460 ;;; ----------------------------------------------------------------------
3461 ;;;
3462 (defun tinycygwin-bug-report-mail-type-wnpp (type &optional info file-list)
3463   "WNPP type request with INFO and FILE-LIST."
3464   (tinycygwin-package-wnpp-main
3465    type
3466    nil
3467    nil
3468    nil
3469    file-list))
3470
3471 ;;; ----------------------------------------------------------------------
3472 ;;;
3473 (defun tinycygwin-bug-report-mail-type-upstream (info &optional file-list)
3474   "Send message to upstream maintainer with package INFO and FILE-LIST."
3475   (let* ((package (tinycygwin-package-info-field-package info))
3476          (name    (tinycygwin-bug-report-email-buffer-name package))
3477          (buffer  (tinycygwin-bug-report-mail-mode-buffer name)))
3478     (message "Sending mail to UPSTREAM has not been implemented yet.")))
3479
3480 ;;; ----------------------------------------------------------------------
3481 ;;;
3482 (defun tinycygwin-bug-report-mail-type-update (info &optional file-list)
3483   "Update request."
3484   (let* ((package (tinycygwin-package-info-field-package info))
3485          (name    (tinycygwin-bug-report-email-buffer-name package))
3486          (buffer  (tinycygwin-bug-report-mail-mode-buffer name)))
3487     (if buffer
3488         (pop-to-buffer buffer)
3489       (tinycygwin-pop-to-buffer (get-buffer-create name))
3490       (let ((subject (tinycygwin-bug-report-mail-subject-compose
3491                       "[UPDATE] Newer package available" package))
3492             (to-list (list
3493                       tinycygwin-:email-cygwin-apps-list
3494                       (tinycygwin-package-info-port-maintainer-maybe
3495                        package))))
3496         (tinycygwin-not-modified-with
3497          (tinycygwin-bug-report-mail-compose
3498           to-list
3499           subject)
3500          (tinycygwin-bug-report-mail-insert-files file-list)
3501          (tinycygwin-bug-report-mail-mode-finish)))
3502       (run-hooks 'tinycygwin-:bug-report-mail-hook))))
3503
3504 ;;; ----------------------------------------------------------------------
3505 ;;;
3506 (defun tinycygwin-bug-report-mail-type (&optional type info file-list)
3507   "Determine correct TYPE of message and act accordingly. This the main bug
3508 report handling semaphore, which delegates the task to correct
3509 function. INFO is alist of package's attributes. FILE-LIST contains
3510 files to attach."
3511   (let* ((package (tinycygwin-package-info-field-package info)))
3512     (tinycygwin-debug
3513      (message "TinyCygwin: Mail-type type [%s] info: %s files: %s"
3514               type info file-list))
3515     (cond
3516      ((and (stringp package)
3517            (string= package "wnpp"))
3518       (tinycygwin-bug-report-mail-type-wnpp type info file-list))
3519      ((and info
3520            (tinycygwin-bug-type-standard-p type))
3521       (tinycygwin-bug-report-mail-type-standard info file-list))
3522      ((and info
3523            (stringp type)
3524            (string= type "update"))
3525       (tinycygwin-bug-report-mail-type-update info file-list))
3526      ((and info
3527            (stringp type)
3528            (string= type "upstream"))
3529       (tinycygwin-bug-report-mail-type-upstream info file-list))
3530      (t
3531       (error
3532        (concat "TinyCygwin: [ERROR] Insufficient information [%s, %s, %s, %s] "
3533                "Perhaps you meant `wnpp'?")
3534        type package info file-list)))))
3535
3536 ;;; ----------------------------------------------------------------------
3537 ;;;
3538 (defun tinycygwin-bug-report-ask-type ()
3539   "Ask type of bug.
3540 References:
3541   `tinycygwin-:menu-bug-classification'
3542   `tinycygwin-:menu-bug-classification-selected'"
3543   (tinycygwin-menu-call-with
3544    'tinycygwin-:menu-bug-classification
3545    tinycygwin-:menu-bug-classification-selected))
3546
3547 ;;; ----------------------------------------------------------------------
3548 ;;;
3549 (defun tinycygwin-bug-report-ask-package (&optional add-list)
3550   "Return package infor by asking and completing name with ADD-LIST."
3551   (let ((package (tinycygwin-package-read-name
3552                   "[TinyCygwin] Report bug to package: "
3553                   nil
3554                   add-list)))
3555     (if (or (not (stringp package))
3556             (string= "" package))
3557         (setq package "bug-generic"))
3558     (tinycygwin-package-info-main package)))
3559
3560 ;;; ----------------------------------------------------------------------
3561 ;;;
3562 (defun tinycygwin-bug-report-mail-main (&optional info type file-list)
3563   "Report bug interactive by mail. TYPE is bug type.
3564 INFO is alist of package's attributes. FILE-LIST are files to attach."
3565   (interactive
3566    (if (tinycygwin-smtp-setup-error)
3567        (list nil)
3568      (let ((info (tinycygwin-bug-report-ask-package
3569                   '("bug-generic" "wnpp"))))
3570        (list
3571         info
3572         (if (tinycygwin-package-wnpp-p
3573              (tinycygwin-package-info-field-package info))
3574             (tinycygwin-package-wnpp-main-interactive)
3575           (tinycygwin-bug-report-ask-type))))))
3576   (tinycygwin-debug
3577    (message "TinyCygwin: mail-mail info %s" (prin1-to-string info)))
3578   (let ((error (unless (interactive-p)
3579                  (tinycygwin-smtp-setup-error))))
3580     (unless error
3581       (tinycygwin-debug
3582        (message "TinyCygwin: mail-main %s" (prin1-to-string info)))
3583       (tinycygwin-bug-report-mail-type type info file-list))))
3584
3585 ;;; ----------------------------------------------------------------------
3586 ;;;
3587 ;;;###autoload
3588 (defun tinycygwin-reportbug ()
3589   "Fully interactive Cygwin bug reporting entrance.
3590 See function `tinycygwin-bug-report-mail-main' which contains more
3591 detailled description."
3592   (interactive)
3593   (call-interactively 'tinycygwin-bug-report-mail-main))
3594
3595 ;;; ----------------------------------------------------------------------
3596 ;;;
3597 (defun tinycygwin-bug-report-mail-package (package &optional type file-list)
3598   "Interface to `tinycygwin-bug-report-mail-main' when PACKAGE is known.
3599 Optional TYPE of bug and possibly attach FILE-LIST."
3600   (tinycygwin-bug-report-mail-main
3601    (tinycygwin-package-status-main package)
3602    type
3603    file-list))
3604
3605 ;;; ----------------------------------------------------------------------
3606 ;;;
3607 (defun tinycygwin-bug-report-batch-include-tag-buffers ()
3608   "Tag all Emacs files as include files to bug report
3609 This function must not be called by any other than function
3610 `tinycygwin-bug-report-mail-batch'."
3611   (dolist (buffer (buffer-list))
3612     (with-current-buffer buffer
3613       (let ((file (buffer-file-name))
3614             (name (buffer-name)))
3615         (when file
3616           (unless (tinycygwin-bug-report-include-buffer-name-p name)
3617             (setq buffer-read-only t)
3618             (rename-buffer
3619              (tinycygwin-bug-report-include-buffer-name name))))))))
3620
3621 ;;; ----------------------------------------------------------------------
3622 ;;;
3623 (defun tinycygwin-bug-report-batch-setup-general ()
3624   "Define Emacs settings for batch bug reporting.
3625 This function is not called if `tinycygwin-:expert-flag' is non-nil.
3626 the setting include e.g.
3627
3628   (setq sentence-end-double-space nil)
3629   (setq colon-double-space        nil)
3630   (setq mouse-yank-at-point       t)
3631   (setq use-dialog-box            nil)
3632   (setq-default fill-column       75)
3633   (setq isearch-lazy-highlight    t)
3634   (setq query-replace-highlight   t)
3635   (setq search-highlight          t)
3636   (setq track-eol                 t)
3637   (setq resize-minibuffer-mode    t)
3638   ..."
3639   (modify-syntax-entry ?-  "w")         ; part of word
3640   (modify-syntax-entry ?\t " ")         ; Treat TABs as spaces.
3641   (setq sentence-end-double-space nil)
3642   (setq colon-double-space        nil)
3643   (setq smtpmail-debug-info       t)
3644   (setq mouse-yank-at-point       t)
3645   (setq use-dialog-box            nil)
3646   (setq-default fill-column       75)
3647   (setq isearch-lazy-highlight    t)
3648   (setq query-replace-highlight   t)
3649   (setq search-highlight          t)
3650   (setq track-eol                 t)
3651   (setq resize-minibuffer-mode    t)
3652   (setq-default indent-tabs-mode  nil) ;; Always spaces, more secure in email
3653   (add-hook 'debugger-mode-hook 'toggle-truncate-lines)
3654   (when (fboundp 'minibuffer-electric-default-mode)
3655     (minibuffer-electric-default-mode  1)))
3656
3657 ;;; ----------------------------------------------------------------------
3658 ;;;
3659 (defun tinycygwin-bug-report-batch-setup-smtp ()
3660   "If SMTPSERVER is set, arrange `smtpmail-send-it' to send mail."
3661   (let ((server (getenv "SMTPSERVER")))
3662     (when server
3663       (setq smtpmail-debug-info           t)
3664       (setq smtpmail-local-domain         nil)
3665       (setq send-mail-function            'smtpmail-send-it)
3666       (setq message-send-mail-function    'smtpmail-send-it)
3667       (setq gnus-agent-send-mail-function 'smtpmail-send-it))))
3668
3669 ;;; ----------------------------------------------------------------------
3670 ;;; This function is called from external program 'cygbug' which see.
3671 ;;;
3672 ;;;###autoload
3673 (defun tinycygwin-bug-report-batch (&optional package)
3674   "This function is called from external script. DO NOT USE.
3675 Do not call this from lisp in any circumstances or it will cause
3676 Emacs to exit."
3677   (let ((tinycygwin-:external-call-flag  t)
3678         (tinycygwin-:debug  tinycygwin-:debug) ;; Make local copy
3679         (tinycygwin-:expert-flag
3680          (if (boundp 'tinycygwin-:command-switch-expert)
3681              tinycygwin-:command-switch-expert))
3682         (tinycygwin-:external-email-address
3683          (if (boundp 'tinycygwin-:command-switch-email)
3684              tinycygwin-:command-switch-email))
3685         (file-list
3686          (if (boundp 'tinycygwin-:command-switch-files)
3687              tinycygwin-:command-switch-files))
3688         (type
3689          (if (boundp 'tinycygwin-:command-switch-type)
3690              tinycygwin-:command-switch-type)))
3691     ;;  Enable these commands
3692     (put 'narrow-to-region 'disabled nil)
3693     (put 'eval-expression  'disabled nil)
3694     (put 'downcase-region  'disabled nil)
3695     (put 'upcase-region    'disabled nil)
3696     ;;  Make answering questions easier, like "Really exit
3697     ;;  "Emacs" when message is being composed still.
3698     (defalias 'yes-or-no-p 'y-or-n-p)
3699     (or package
3700         (setq package
3701               (when (boundp 'tinycygwin-:command-switch-package)
3702                 ;;  Because this is called from external script,
3703                 ;;  be cautious and activate debug to pinpoint
3704                 ;;  possible errors.
3705                 (setq tinycygwin-:debug t)
3706                 tinycygwin-:command-switch-package)))
3707     (unless package
3708       (error "** [ERROR] Need Cygwin PACKAGE name in order to report bug."))
3709     (when (and (null type)
3710                (tinycygwin-package-wnpp-p package))
3711       (let ((loop t)
3712             selection)
3713         (while loop
3714           (cond
3715            ((setq type (tinycygwin-package-wnpp-main-interactive))
3716             (setq loop nil))
3717            ((when (y-or-n-p
3718                    "Select other package bug/WNPP again (C-g to abort)? ")
3719               (setq selection
3720                     (tinycygwin-package-read-name
3721                      "[TinyCygwin] Report bug to package: "
3722                      nil
3723                      '("bug-generic")))
3724               (cond
3725                ((string-match "^[ \t\r\n]*$" selection)
3726                 (message "Hm, nothing selected. Trying agian...")
3727                 (sit-for 1))
3728                (t
3729                 (setq package selection
3730                       loop    nil)))))))))
3731     (tinycygwin-bug-report-batch-setup-smtp)
3732     (tinycygwin-non-expert-with
3733      (tinycygwin-bug-report-batch-setup-general)
3734      (when nil ;; disabled for now
3735        ;;  Print clear message to Emacs novices.
3736        (message
3737         (substitute-command-keys
3738          (concat
3739           "[INFO] Exit \\[save-buffers-kill-emacs]  "
3740           "Abort \\[keyboard-quit]  "
3741           "")))
3742        (sit-for 1.9)))
3743     (tinycygwin-bug-report-batch-include-tag-buffers)
3744     (tinycygwin-bug-report-mail-package package type file-list)))
3745
3746 ;;}}}
3747
3748 ;; Auto-created functions
3749 (tinycygwin-install-severity-functions)
3750 (tinycygwin-install-bug-classification-functions)
3751 (tinycygwin-install-message-mode)
3752
3753 (provide   'tinycygwin)
3754 (run-hooks 'tinycygwin-:load-hook)
3755
3756 ;;; tinycygwin.el ends here