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