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