1;;;; -*-emacs-lisp-*- 2;;;;--------------------------------------------------------------------------- 3;;;; EMACS interface for send-pr (by Heinz G. Seidl) 4;;;; Slightly hacked by Brendan Kehoe (brendan@cygnus.com). 5;;;; 6;;;; This file is part of the Problem Report Management System (GNATS) 7;;;; Copyright 1992, 1993, 1997 Cygnus Support 8;;;; 9;;;; This program is free software; you can redistribute it and/or 10;;;; modify it under the terms of the GNU General Public 11;;;; License as published by the Free Software Foundation; either 12;;;; version 2 of the License, or (at your option) any later version. 13;;;; 14;;;; This program is distributed in the hope that it will be useful, 15;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17;;;; General Public License for more details. 18;;;; 19;;;; You should have received a copy of the GNU Library General Public 20;;;; License along with this program; if not, write to the Free 21;;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 22;;;; 23;;;;--------------------------------------------------------------------------- 24;;;; 25;;;; This file contains the EMACS interface to the Problem Report Management 26;;;; System (GNATS): 27;;;; 28;;;; - The `send-pr' command and the `send-pr-mode' for sending 29;;;; Problem Reports (PRs). 30;;;; 31;;;; For more information about how to send a PR see send-pr(1). 32;;;; 33;;;;--------------------------------------------------------------------------- 34;;;; 35;;;; Configuration: the symbol `DEFAULT-RELEASE' can be replaced by 36;;;; site/release specific strings during the configuration/installation 37;;;; process. 38;;;; 39;;;; Install this file in your EMACS library directory. 40;;;; 41;;;;--------------------------------------------------------------------------- 42;;;; 43;;;; $FreeBSD$ 44 45(provide 'send-pr) 46 47;;;;--------------------------------------------------------------------------- 48;;;; Customization: put the following forms into your default.el file 49;;;; (or into your .emacs) 50;;;;--------------------------------------------------------------------------- 51 52;(autoload 'send-pr-mode "send-pr" 53; "Major mode for sending problem reports." t) 54 55;(autoload 'send-pr "send-pr" 56; "Command to create and send a problem report." t) 57 58;;;;--------------------------------------------------------------------------- 59;;;; End of Customization Section 60;;;;--------------------------------------------------------------------------- 61 62(autoload 'server-buffer-done "server") 63(defvar server-buffer-clients nil) 64(defvar mail-self-blind nil) 65(defvar mail-default-reply-to nil) 66 67(defconst send-pr::version "3.113") 68 69(defvar gnats:root "/home/gnats" 70 "*The top of the tree containing the GNATS database.") 71 72;;;;--------------------------------------------------------------------------- 73;;;; hooks 74;;;;--------------------------------------------------------------------------- 75 76(defvar text-mode-hook nil) ; we define it here in case it's not defined 77(defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.") 78 79;;;;--------------------------------------------------------------------------- 80;;;; Domains and default values for (some of) the Problem Report fields; 81;;;; constants and definitions. 82;;;;--------------------------------------------------------------------------- 83 84(defconst gnats::emacs-19p 85 (not (or (and (boundp 'epoch::version) epoch::version) 86 (string-lessp emacs-version "19"))) 87 "Is this emacs v19?") 88 89;;; This has to be here rather than at the bottom of this file with 90;;; the other utility functions because it is used by 91;;; gnats::get-config, which is called when send-pr.el is being 92;;; loaded (see the "defconst" below), before the whole file has been 93;;; loaded. 94 95(defun gnats::find-safe-default-directory (&optional buffer) 96"If the directory referred to by `default-directory' for the current 97buffer (or for optional argument BUFFER) does not exist, set it to the home 98directory of the current user if that exists, or to `/'. 99 100Returns the final value of default-directory in the buffer." 101 (let ((homedir (expand-file-name "~/"))) 102 (save-excursion 103 (if buffer (set-buffer buffer)) 104 (if (not (file-exists-p default-directory)) 105 (if (file-exists-p homedir) 106 (setq default-directory homedir) 107 (setq default-directory "/"))) 108 default-directory))) 109 110;;; These may be changed during configuration/installation or by the individual 111;;; user in his/her .emacs file. 112;;; 113(defun gnats::get-config (var) 114 (let ((shell-file-name "/bin/sh") 115 (buf (generate-new-buffer " *GNATS config*")) 116 ret) 117 (save-excursion 118 (set-buffer buf) 119 (shell-command-on-region 120 (point-min) (point-max) 121 (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t) 122 (goto-char (point-min)) 123 ; We have to use get-buffer, since shell-command-on-region will wipe 124 ; out the buffer if there's no output from the command. 125 (if (or (not (get-buffer "*Shell Command Output*")) 126 (looking-at "^\\.:\\|/bin/sh:\\|\n")) 127 (setq ret nil) 128 (setq ret (buffer-substring (point-min) (- (point-max) 1))))) 129 (if (and ret (string-equal ret "")) (setq ret nil)) 130 (kill-buffer buf) 131 ret)) 132 133;; const because it must match the script's value 134(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@") 135 "*Where the `gnats' subdirectory containing category lists lives.") 136 137(defvar send-pr::sites nil 138 "List of GNATS support sites; computed at runtime.") 139(defvar send-pr:default-site 140 (or (gnats::get-config "GNATS_SITE") "freefall") 141 "Default site to send bugs to.") 142(defvar send-pr:::site send-pr:default-site 143 "The site to which a problem report is currently being submitted, or NIL 144if using the default site (buffer local).") 145 146(defvar send-pr:::categories nil 147 "Buffer local list of available categories, derived at runtime from 148send-pr:::site and send-pr::category-alist.") 149(defvar send-pr::category-alist nil 150 "Alist of GNATS support sites and the categories supported at each; computed 151at runtime.") 152 153;;; Ideally we would get all the following values from a central database 154;;; during runtime instead of having them here in the code. 155;;; 156(defconst send-pr::fields 157 (` (("Category" send-pr::set-categories 158 (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum) 159 ("Class" (("sw-bug") ("doc-bug") ("change-request") ("update") ("maintainer-update")) 160 (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum) 161 ("Confidential" (("yes") ("no")) 162 (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum) 163 ("Severity" (("non-critical") ("serious") ("critical")) 164 (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum) 165 ("Priority" (("low") ("medium") ("high")) 166 (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum) 167 ("Release" nil 168 (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@")) 169 text) 170 ("Submitter-Id" nil 171 (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) text) 172 ("Synopsis" nil nil text 173 (lambda (a b c) (gnats::set-mail-field "Subject" c))))) 174 "AList, keyed on the name of the field, of: 1751) The field name. 1762) The list of completions. This can be a list, a function to call, or nil. 1773) The default value. 1784) The type of the field. 1795) A sub-function to call when changed.") 180 181(defvar gnats::fields nil) 182 183(defmacro gnats::push (i l) 184 (` (setq (, l) (cons (,@ (list i l)))))) 185 186(defun send-pr::set-categories (&optional arg) 187 "Get the list of categories for the current site out of 188send-pr::category-alist if there or from send-pr if not. With arg, force 189update." 190 ;; 191 (let ((entry (assoc send-pr:::site send-pr::category-alist))) 192 (or (and entry (null arg)) 193 (let ((oldpr (getenv "GNATS_ROOT")) cats) 194 (send-pr::set-sites arg) 195 (setenv "GNATS_ROOT" gnats:root) 196 (setq cats (gnats::get-value-from-shell 197 "send-pr" "-CL" send-pr:::site)) 198 (setenv "GNATS_ROOT" oldpr) 199 (if entry (setcdr entry cats) 200 (setq entry (cons send-pr:::site cats)) 201 (gnats::push entry send-pr::category-alist)))) 202 (setq send-pr:::categories (cdr entry)))) 203 204(defun send-pr::set-sites (&optional arg) 205 "Get the list of sites (by listing the contents of DATADIR/gnats) and assign 206it to send-pr::sites. With arg, force update." 207 (or (and (null arg) send-pr::sites) 208 (progn 209 (setq send-pr::sites nil) 210 (mapcar 211 (function 212 (lambda (file) 213 (or (memq t (mapcar (function (lambda (x) (string= x file))) 214 '("." ".." "pr-edit" "pr-addr"))) 215 (not (file-readable-p file)) 216 (gnats::push (list (file-name-nondirectory file)) 217 send-pr::sites)))) 218 (directory-files (format "%s/gnats" send-pr:datadir) t)) 219 (setq send-pr::sites (reverse send-pr::sites))))) 220 221(defconst send-pr::pr-buffer-name "*send-pr*" 222 "Name of the temporary buffer, where the problem report gets composed.") 223 224(defconst send-pr::err-buffer-name "*send-pr-error*" 225 "Name of the temporary buffer, where send-pr error messages appear.") 226 227(defvar send-pr:::err-buffer nil 228 "The error buffer used by the current PR buffer.") 229 230(defvar send-pr:::spawn-to-send nil 231 "Whether or not send-pr-mode should spawn a send-pr process to send the PR.") 232 233(defconst gnats::indent 17 "Indent for formatting the value.") 234 235;;;;--------------------------------------------------------------------------- 236;;;; `send-pr' - command for creating and sending of problem reports 237;;;;--------------------------------------------------------------------------- 238 239(fset 'send-pr 'send-pr:send-pr) 240(defun send-pr:send-pr (&optional site) 241 "Create a buffer and read in the result of `send-pr -P'. 242When finished with editing the problem report use \\[send-pr:submit-pr] 243to send the PR with `send-pr -b -f -'." 244 ;; 245 (interactive 246 (if current-prefix-arg 247 (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t 248 send-pr:default-site)))) 249 (or site (setq site send-pr:default-site)) 250 (let ((buf (get-buffer send-pr::pr-buffer-name))) 251 (if (or (not buf) 252 (progn (switch-to-buffer buf) 253 (cond ((or (not (buffer-modified-p buf)) 254 (y-or-n-p "Erase previous problem report? ")) 255 (erase-buffer) t) 256 (t nil)))) 257 (send-pr::start-up site)))) 258 259(defun send-pr::start-up (site) 260 (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name)) 261 (setq default-directory (expand-file-name "~/")) 262 (auto-save-mode auto-save-default) 263 (let ((oldpr (getenv "GNATS_ROOT")) 264 (case-fold-search nil)) 265 (setenv "GNATS_ROOT" gnats:root) 266 (send-pr::insert-template site) 267 (setenv "GNATS_ROOT" oldpr) 268 (goto-char (point-min)) 269 (if (looking-at "send-pr:") 270 (cond ((looking-at "send-pr: .* does not have a categories list") 271 (setq send-pr::sites nil) 272 (error "send-pr: the GNATS site %s does not have a categories list" site)) 273 (t (error (buffer-substring (point-min) (point-max))))) 274 (save-excursion 275 ;; Clear cruft inserted by bdamaged .cshrcs 276 (goto-char 1) 277 (re-search-forward "^SEND-PR:") 278 (delete-region 1 (match-beginning 0))))) 279 (set-buffer-modified-p nil) 280 (send-pr:send-pr-mode) 281 (setq send-pr:::site site) 282 (setq send-pr:::spawn-to-send t) 283 (send-pr::set-categories) 284 (if (null send-pr:::categories) 285 (progn 286 (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer)) 287 (kill-buffer nil) 288 (message "send-pr: no categories found")) 289 (or (stringp mail-default-reply-to) 290 (setq mail-default-reply-to (getenv "REPLYTO"))) 291 (and mail-default-reply-to 292 (gnats::set-mail-field "Reply-To" mail-default-reply-to)) 293 (and mail-self-blind 294 (gnats::set-mail-field "BCC" (user-login-name))) 295 (mapcar 'send-pr::maybe-change-field send-pr::fields) 296 (gnats::position-on-field "Description") 297 (message (substitute-command-keys 298 "To send the problem report use: \\[send-pr:submit-pr]")))) 299 300(defvar send-pr::template-alist nil 301 "An alist containing the output of send-pr -P <sitename> for various sites.") 302 303(defun send-pr::insert-template (site) 304 (let ((elt (assoc site send-pr::template-alist))) 305 (if elt 306 (save-excursion (insert (cdr elt))) 307 (call-process "send-pr" nil t nil "-P" site) 308 (save-excursion 309 (setq send-pr::template-alist 310 (cons (cons site (buffer-substring (point-min) (point-max))) 311 send-pr::template-alist)))))) 312 313(fset 'do-send-pr 'send-pr:submit-pr) ;backward compat 314(defun send-pr:submit-pr () 315 "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this 316buffer was loaded with emacsclient, in which case save the buffer and exit." 317 ;; 318 (interactive) 319 (cond 320 ((and (boundp 'server-buffer-clients) 321 server-buffer-clients) 322 (let ((buffer (current-buffer)) 323 (version-control nil) (buffer-backed-up nil)) 324 (save-buffer buffer) 325 (kill-buffer buffer) 326 (server-buffer-done buffer))) 327 (send-pr:::spawn-to-send 328 (if (or (buffer-modified-p) 329 (not send-pr:::sent) 330 (y-or-n-p "PR already sent; resend? ")) 331 (progn 332 (or (and send-pr:::err-buffer 333 (buffer-name send-pr:::err-buffer)) 334 (setq send-pr:::err-buffer 335 (get-buffer-create send-pr::err-buffer-name))) 336 (let ((err-buffer send-pr:::err-buffer) mesg ok) 337 (save-excursion (set-buffer err-buffer) (erase-buffer)) 338 (message "running send-pr...") 339 (let ((oldpr (getenv "GNATS_ROOT"))) 340 (setenv "GNATS_ROOT" gnats:root) 341 ;; ensure that a final newline is present: 342 (if (not (equal (char-after (1- (point-max))) ?\n)) 343 (save-excursion (goto-char (point-max)) 344 (insert ?\n))) 345 (call-process-region (point-min) (point-max) "send-pr" 346 nil err-buffer nil send-pr:::site 347 "-b" "-f" "-") 348 (setenv "GNATS_ROOT" oldpr)) 349 (message "running send-pr...done") 350 ;; stupidly we cannot check the return value in EMACS 18.57, 351 ;; thus we need this kluge to find out whether send-pr succeeded. 352 (if (save-excursion 353 (set-buffer err-buffer) 354 (goto-char (point-min)) 355 (setq mesg (buffer-substring (point-min) (- (point-max) 1))) 356 (search-forward "problem report sent" nil t)) 357 (progn (message mesg) 358 (kill-buffer err-buffer) 359 (delete-auto-save-file-if-necessary) 360 (set-buffer-modified-p nil) 361 (setq send-pr:::sent t) 362 (bury-buffer)) 363 (pop-to-buffer err-buffer)) 364 )))) 365 (t 366 (save-buffer) 367 (message "Exit emacs to send the PR.")))) 368 369;;;;--------------------------------------------------------------------------- 370;;;; send-pr:send-pr-mode mode 371;;;;--------------------------------------------------------------------------- 372 373(defvar send-pr-mode-map 374 (let ((map (make-sparse-keymap))) 375 (define-key map "\C-c\C-c" 'send-pr:submit-pr) 376 (define-key map "\C-c\C-f" 'gnats:change-field) 377 (define-key map "\M-n" 'gnats:next-field) 378 (define-key map "\M-p" 'gnats:previous-field) 379 (define-key map "\C-\M-f" 'gnats:forward-field) 380 (define-key map "\C-\M-b" 'gnats:backward-field) 381 map) 382 "Keymap for send-pr mode.") 383 384(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):") 385(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):") 386(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+") 387 388(fset 'send-pr-mode 'send-pr:send-pr-mode) 389(defun send-pr:send-pr-mode () 390 "Major mode for submitting problem reports. 391For information about the form see gnats(1) and send-pr(1). 392Special commands: \\{send-pr-mode-map} 393Turning on send-pr-mode calls the value of the variable send-pr-mode-hook, 394if it is not nil." 395 (interactive) 396 (gnats::patch-exec-path) 397 (put 'send-pr:send-pr-mode 'mode-class 'special) 398 (kill-all-local-variables) 399 (setq major-mode 'send-pr:send-pr-mode) 400 (setq mode-name "send-pr") 401 (use-local-map send-pr-mode-map) 402 (set-syntax-table text-mode-syntax-table) 403 (setq local-abbrev-table text-mode-abbrev-table) 404 (setq buffer-offer-save t) 405 (make-local-variable 'send-pr:::site) 406 (make-local-variable 'send-pr:::categories) 407 (make-local-variable 'send-pr:::err-buffer) 408 (make-local-variable 'send-pr:::spawn-to-send) 409 (make-local-variable 'send-pr:::sent) 410 (setq send-pr:::sent nil) 411 (make-local-variable 'paragraph-separate) 412 (setq paragraph-separate (concat (default-value 'paragraph-separate) 413 "\\|" gnats::keyword "[ \t\n\f]*$")) 414 (make-local-variable 'paragraph-start) 415 (setq paragraph-start (concat (default-value 'paragraph-start) 416 "\\|" gnats::keyword)) 417 (run-hooks 'send-pr-mode-hook) 418 t) 419 420;;;;--------------------------------------------------------------------------- 421;;;; Functions to read and replace field values. 422;;;;--------------------------------------------------------------------------- 423 424(defun gnats::position-on-field (field &optional quiet) 425 (goto-char (point-min)) 426 (if (not (re-search-forward (concat "^>" field ":") nil t)) 427 (if quiet 428 nil 429 (error "Field `>%s:' not found." field)) 430 (re-search-forward "[ \t\n\f]*") 431 (if (looking-at gnats::keyword) 432 (backward-char 1)) 433 t)) 434 435(defun gnats::mail-position-on-field (field) 436 (let (end 437 (case-fold-search t)) 438 (goto-char (point-min)) 439 (re-search-forward "^$") 440 (setq end (match-beginning 0)) 441 (goto-char (point-min)) 442 (if (not (re-search-forward (concat "^" field ":") end 'go-to-end)) 443 (insert field ": \n") 444 (re-search-forward "[ \t\n\f]*")) 445 (skip-chars-backward "\n") 446 t)) 447 448(defun gnats::field-contents (field &optional elem move) 449 (let (pos) 450 (unwind-protect 451 (save-excursion 452 (if (not (gnats::position-on-field field t)) 453 nil 454 (setq pos (point-marker)) 455 (if (or (looking-at "<.*>$") (eolp)) 456 t 457 (looking-at ".*$") ; to set match-{beginning,end} 458 (gnats::nth-word 459 (buffer-substring (match-beginning 0) (match-end 0)) 460 elem)))) 461 (and move pos (goto-char pos))))) 462 463(defun gnats::functionp (thing) 464 (or (and (symbolp thing) (fboundp thing)) 465 (and (listp thing) (eq (car thing) 'lambda)))) 466 467(defun gnats::field-values (field) 468 "Return the possible (known) values for field FIELD." 469 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 470 send-pr::fields)) 471 (thing (elt (assoc field fields) 1))) 472 (cond ((gnats::functionp thing) (funcall thing)) 473 ((listp thing) thing) 474 (t (error "ACK"))))) 475 476(defun gnats::field-default (field) 477 "Return the default value for field FIELD." 478 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 479 send-pr::fields)) 480 (thing (elt (assoc field fields) 2))) 481 (cond ((stringp thing) thing) 482 ((null thing) "") 483 ((numberp thing) (car (elt (gnats::field-values field) thing))) 484 ((gnats::functionp thing) 485 (funcall thing (gnats::field-contents field))) 486 ((eq thing t) (gnats::field-contents field)) 487 (t (error "ACK"))))) 488 489(defun gnats::field-type (field) 490 "Return the type of field FIELD." 491 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 492 send-pr::fields)) 493 (thing (elt (assoc field fields) 3))) 494 thing)) 495 496(defun gnats::field-action (field) 497 "Return the extra handling function for field FIELD." 498 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 499 send-pr::fields)) 500 (thing (elt (assoc field fields) 4))) 501 (cond ((null thing) 'ignore) 502 ((gnats::functionp thing) thing) 503 (t (error "ACK"))))) 504 505;;;;--------------------------------------------------------------------------- 506;;;; Point movement functions 507;;;;--------------------------------------------------------------------------- 508 509(or (fboundp 'defsubst) (fset 'defsubst 'defun)) 510 511(defun send-pr::maybe-change-field (field) 512 (setq field (car field)) 513 (let ((thing (gnats::field-contents field))) 514 (and thing (eq t thing) 515 (not (eq 'multi-text (gnats::field-type field))) 516 (gnats:change-field field)))) 517 518(defun gnats:change-field (&optional field default) 519 "Change the value of the field containing the cursor. With arg, ask the 520user for the field to change. From a program, the function takes optional 521arguments of the field to change and the default value to use." 522 (interactive) 523 (or field current-prefix-arg (setq field (gnats::current-field))) 524 (or field 525 (setq field 526 (completing-read "Field: " 527 (if (eq major-mode 'gnats:gnats-mode) 528 gnats::fields 529 send-pr::fields) 530 nil t))) 531 (gnats::position-on-field field) 532 (sit-for 0) 533 (let* ((old (gnats::field-contents field)) 534 new) 535 (if (null old) 536 (error "ACK") 537 (if (or (interactive-p) t) 538 (let ((prompt (concat ">" field ": ")) 539 (domain (gnats::field-values field)) 540 (type (gnats::field-type field))) 541 (or default (setq default (gnats::field-default field))) 542 (setq new 543 (if (eq type 'enum) 544 (completing-read prompt domain nil t 545 (if gnats::emacs-19p (cons default 0) 546 default)) 547 (read-string prompt (if gnats::emacs-19p (cons default 1) 548 default))))) 549 (setq new default)) 550 (gnats::set-field field new) 551 (funcall (gnats::field-action field) field old new) 552 new))) 553 554(defun gnats::set-field (field value) 555 (save-excursion 556 (gnats::position-on-field field) 557 (delete-horizontal-space) 558 (looking-at ".*$") 559 (replace-match 560 (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t))) 561 562(defun gnats::set-mail-field (field value) 563 (save-excursion 564 (gnats::mail-position-on-field field) 565 (delete-horizontal-space) 566 (looking-at ".*$") 567 (replace-match (concat " " value) t))) 568 569(defun gnats::before-keyword (&optional where) 570 "Returns t if point is in some white space before a keyword. 571If where is nil, then point is not changed; if where is t then point is moved 572to the beginning of the keyword, otherwise it is moved to the beginning 573of the white space it was in." 574 ;; 575 (if (looking-at gnats::before-keyword) 576 (prog1 t 577 (cond ((eq where t) 578 (re-search-forward "^>") (backward-char)) 579 ((not (eq where nil)) 580 (re-search-backward "[^ \t\n\f]") (forward-char)))) 581 nil)) 582 583(defun gnats::after-keyword (&optional where) 584 "Returns t if point is in some white space after a keyword. 585If where is nil, then point is not changed; if where is t then point is moved 586to the beginning of the keyword, otherwise it is moved to the end of the white 587space it was in." 588 ;; 589 (if (gnats::looking-after gnats::after-keyword) 590 (prog1 t 591 (cond ((eq where t) 592 (re-search-backward "^>")) 593 ((not (eq where nil)) 594 (re-search-forward "[^ \t\n\f]") (backward-char)))) 595 nil)) 596 597(defun gnats::in-keyword (&optional where) 598 "Returns t if point is within a keyword. 599If where is nil, then point is not changed; if where is t then point is moved 600to the beginning of the keyword." 601 ;; 602 (let ((old-point (point-marker))) 603 (beginning-of-line) 604 (cond ((and (looking-at gnats::keyword) 605 (< old-point (match-end 0))) 606 (prog1 t 607 (if (eq where t) 608 t 609 (goto-char old-point)))) 610 (t (goto-char old-point) 611 nil)))) 612 613(defun gnats::forward-bofield () 614 "Moves point to the beginning of a field. Assumes that point is in the 615keyword." 616 ;; 617 (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-) 618 (backward-char) 619 t)) 620 621(defun gnats::backward-eofield () 622 "Moves point to the end of a field. Assumes point is in the keyword." 623 ;; 624 (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-) 625 (forward-char) 626 t)) 627 628(defun gnats::forward-eofield () 629 "Moves point to the end of a field. Assumes that point is in the field." 630 ;; 631 ;; look for the next field 632 (if (re-search-forward gnats::keyword (point-max) '-) 633 (progn (beginning-of-line) (gnats::backward-eofield)) 634 (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-) 635 (forward-char))) 636 637(defun gnats::backward-bofield () 638 "Moves point to the beginning of a field. Assumes that point is in the 639field." 640 ;; 641 ;;look for previous field 642 (if (re-search-backward gnats::keyword (point-min) '-) 643 (gnats::forward-bofield) 644 t)) 645 646 647(defun gnats:forward-field () 648 "Move point forward to the end of the field or to the beginning of the next 649field." 650 ;; 651 (interactive) 652 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 653 (gnats::after-keyword t)) 654 (gnats::forward-bofield) 655 (gnats::forward-eofield))) 656 657(defun gnats:backward-field () 658 "Move point backward to the beginning/end of a field." 659 ;; 660 (interactive) 661 (backward-char) 662 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 663 (gnats::after-keyword t)) 664 (gnats::backward-eofield) 665 (gnats::backward-bofield))) 666 667(defun gnats:next-field () 668 "Move point to the beginning of the next field." 669 ;; 670 (interactive) 671 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 672 (gnats::after-keyword t)) 673 (gnats::forward-bofield) 674 (if (re-search-forward gnats::keyword (point-max) '-) 675 (gnats::forward-bofield) 676 t))) 677 678(defun gnats:previous-field () 679 "Move point to the beginning of the previous field." 680 ;; 681 (interactive) 682 (backward-char) 683 (if (or (gnats::after-keyword t) (gnats::in-keyword t) 684 (gnats::before-keyword t)) 685 (progn (re-search-backward gnats::keyword (point-min) '-) 686 (gnats::forward-bofield)) 687 (gnats::backward-bofield))) 688 689(defun gnats:beginning-of-field () 690 "Move point to the beginning of the current field." 691 (interactive) 692 (cond ((gnats::in-keyword t) 693 (gnats::forward-bofield)) 694 ((gnats::after-keyword 0)) 695 (t 696 (gnats::backward-bofield)))) 697 698(defun gnats::current-field () 699 (save-excursion 700 (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t)) 701 (looking-at gnats::keyword)) 702 ((re-search-backward gnats::keyword nil t))) 703 (buffer-substring (match-beginning 1) (match-end 1)) 704 nil))) 705 706;;;;--------------------------------------------------------------------------- 707;;;; Support functions 708;;;;--------------------------------------------------------------------------- 709 710(defun gnats::looking-after (regex) 711 "Returns t if point is after regex." 712 ;; 713 (let* ((old-point (point)) 714 (start (if (eobp) 715 old-point 716 (forward-char) (point)))) 717 (cond ((re-search-backward regex (point-min) t) 718 (goto-char old-point) 719 (cond ((eq (match-end 0) start) 720 t)))))) 721 722(defun gnats::nth-word (string &optional elem) 723 "Returns the elem-th word of the string. 724If elem is nil, then the first wort is returned, if elem is 0 then 725the whole string is returned." 726 ;; 727 (if (integerp elem) 728 (cond ((eq elem 0) string) 729 ((eq elem 1) (gnats::first-word string)) 730 ((equal string "") "") 731 ((>= elem 2) 732 (let ((i 0) (value "")) 733 (setq string ; strip leading blanks 734 (substring string (or (string-match "[^ \t]" string) 0))) 735 (while (< i elem) 736 (setq value 737 (substring string 0 738 (string-match "[ \t]*$\\|[ \t]+" string))) 739 (setq string 740 (substring string (match-end 0))) 741 (setq i (+ i 1))) 742 value))) 743 (gnats::first-word string))) 744 745(defun gnats::first-word (string) 746 (setq string 747 (substring string (or (string-match "[^ \t]" string) 0))) 748 (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string))) 749 750;;;;--------------------------------------------------------------------------- 751 752(defun gnats::patch-exec-path () 753 ;; 754 "Replaces `//' by `/' in `exec-path'." 755 ;; 756 ;(make-local-variable 'exec-path) 757 (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*")) 758 (ret)) 759 (setq exec-path (save-excursion (set-buffer err-buffer) 760 (prin1 exec-path err-buffer) 761 (goto-char (point-min)) 762 (while (search-forward "//" nil t) 763 (replace-match "/" nil t)) 764 (goto-char (point-min)) 765 (setq ret (read err-buffer)) 766 (kill-buffer err-buffer) 767 ret 768 )))) 769 770(defun gnats::get-value-from-shell (&rest command) 771 "Execute shell command to get a list of valid values for `variable'." 772 ;; 773 (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*"))) 774 (save-excursion 775 (set-buffer err-buffer) 776 (unwind-protect 777 (condition-case var 778 (progn 779 (apply 'call-process 780 (car command) nil err-buffer nil (cdr command)) 781 (goto-char (point-min)) 782 (if (looking-at "[-a-z]+: ") 783 (error (buffer-substring (point-min) (point-max)))) 784 (read err-buffer)) 785 (error nil)) 786 (kill-buffer err-buffer))))) 787 788(or (fboundp 'setenv) 789 (defun setenv (variable &optional value) 790 "Set the value of the environment variable named VARIABLE to VALUE. 791VARIABLE should be a string. VALUE is optional; if not provided or is 792`nil', the environment variable VARIABLE will be removed. 793This function works by modifying `process-environment'." 794 (interactive "sSet environment variable: \nsSet %s to value: ") 795 (if (string-match "=" variable) 796 (error "Environment variable name `%s' contains `='" variable) 797 (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) 798 (case-fold-search nil) 799 (scan process-environment)) 800 (while scan 801 (cond 802 ((string-match pattern (car scan)) 803 (if (eq nil value) 804 (setq process-environment (delq (car scan) 805 process-environment)) 806 (setcar scan (concat variable "=" value))) 807 (setq scan nil)) 808 ((null (setq scan (cdr scan))) 809 (setq process-environment 810 (cons (concat variable "=" value) 811 process-environment))))))))) 812 813;;;; end of send-pr.el 814