send-pr-el.in revision 59366
11558Srgrimes;;;; -*-emacs-lisp-*- 21558Srgrimes;;;;--------------------------------------------------------------------------- 31558Srgrimes;;;; EMACS interface for send-pr (by Heinz G. Seidl, hgs@cygnus.com) 41558Srgrimes;;;; Slightly hacked by Brendan Kehoe (brendan@cygnus.com). 51558Srgrimes;;;; 61558Srgrimes;;;; This file is part of the Problem Report Management System (GNATS) 71558Srgrimes;;;; Copyright 1992, 1993 Cygnus Support 81558Srgrimes;;;; 91558Srgrimes;;;; This program is free software; you can redistribute it and/or 101558Srgrimes;;;; modify it under the terms of the GNU General Public 111558Srgrimes;;;; License as published by the Free Software Foundation; either 121558Srgrimes;;;; version 2 of the License, or (at your option) any later version. 131558Srgrimes;;;; 141558Srgrimes;;;; This program is distributed in the hope that it will be useful, 151558Srgrimes;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 161558Srgrimes;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 171558Srgrimes;;;; General Public License for more details. 181558Srgrimes;;;; 191558Srgrimes;;;; You should have received a copy of the GNU Library General Public 201558Srgrimes;;;; License along with this program; if not, write to the Free 211558Srgrimes;;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 221558Srgrimes;;;; 231558Srgrimes;;;;--------------------------------------------------------------------------- 241558Srgrimes;;;; 251558Srgrimes;;;; This file contains the EMACS interface to the Problem Report Management 261558Srgrimes;;;; System (GNATS): 271558Srgrimes;;;; 2826683Sbde;;;; - The `send-pr' command and the `send-pr-mode' for sending 2950476Speter;;;; Problem Reports (PRs). 301558Srgrimes;;;; 31302388Strasz;;;; For more information about how to send a PR see send-pr(1). 321558Srgrimes;;;; 3379530Sru;;;;--------------------------------------------------------------------------- 341558Srgrimes;;;; 351558Srgrimes;;;; Configuration: the symbol `DEFAULT-RELEASE' can be replaced by 36102231Strhodes;;;; site/release specific strings during the configuration/installation 371558Srgrimes;;;; process. 3868960Sru;;;; 39302388Strasz;;;; Install this file in your EMACS library directory. 40219955Sru;;;; 4168960Sru;;;;--------------------------------------------------------------------------- 4226683Sbde;;;; 43113220Smdodd;;;; $FreeBSD: head/gnu/usr.bin/send-pr/send-pr-el.in 59366 2000-04-18 15:03:34Z steve $ 44302388Strasz 451558Srgrimes(provide 'send-pr) 4626683Sbde 471558Srgrimes;;;;--------------------------------------------------------------------------- 481558Srgrimes;;;; Customization: put the following forms into your default.el file 4928458Ssteve;;;; (or into your .emacs) 5099503Scharnier;;;;--------------------------------------------------------------------------- 511558Srgrimes 52117742Siedowse;(autoload 'send-pr-mode "send-pr" 53117742Siedowse; "Major mode for sending problem reports." t) 541558Srgrimes 55117742Siedowse;(autoload 'send-pr "send-pr" 561558Srgrimes; "Command to create and send a problem report." t) 57117742Siedowse 58117742Siedowse;;;;--------------------------------------------------------------------------- 59117742Siedowse;;;; End of Customization Section 60196287Spjd;;;;--------------------------------------------------------------------------- 61196287Spjd 621558Srgrimes(autoload 'server-buffer-done "server") 631558Srgrimes(defvar server-buffer-clients nil) 641558Srgrimes(defvar mail-self-blind nil) 651558Srgrimes(defvar mail-default-reply-to nil) 66102231Strhodes 671558Srgrimes(defconst send-pr::version "3.2") 681558Srgrimes 6926683Sbde(defvar gnats:root "/home/gnats" 70102231Strhodes "*The top of the tree containing the GNATS database.") 7126683Sbde 72113220Smdodd;;;;--------------------------------------------------------------------------- 73113220Smdodd;;;; hooks 74113220Smdodd;;;;--------------------------------------------------------------------------- 75113220Smdodd 761558Srgrimes(defvar text-mode-hook nil) ; we define it here in case it's not defined 77102231Strhodes(defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.") 781558Srgrimes 791558Srgrimes;;;;--------------------------------------------------------------------------- 80102231Strhodes;;;; Domains and default values for (some of) the Problem Report fields; 81222541Srmacklem;;;; constants and definitions. 82222541Srmacklem;;;;--------------------------------------------------------------------------- 83222541Srmacklem 84284531Srmacklem(defconst gnats::emacs-19p 85284531Srmacklem (not (or (and (boundp 'epoch::version) epoch::version) 86284531Srmacklem (string-lessp emacs-version "19"))) 871558Srgrimes "Is this emacs v19?") 88102231Strhodes 891558Srgrimes;;; These may be changed during configuration/installation or by the individual 9028458Ssteve;;; user in his/her .emacs file. 9126683Sbde;;; 921558Srgrimes(defun gnats::get-config (var) 931558Srgrimes (let ((shell-file-name "/bin/sh") 9438041Scharnier (buf (generate-new-buffer " *GNATS config*")) 9538041Scharnier ret) 96102231Strhodes (save-excursion 97302388Strasz (set-buffer buf) 98302388Strasz (shell-command (concat ". " gnats:root "/gnats-adm/config; echo $" var ) 99302388Strasz t) 100302388Strasz (if (looking-at "^\\.:\\|/bin/sh:\\|\n") 101302388Strasz (setq ret nil) 102302388Strasz (setq ret (buffer-substring (point-min) (- (point-max) 1))))) 103302388Strasz (kill-buffer buf) 104302388Strasz ret)) 105302388Strasz 10626683Sbde;; const because it must match the script's value 1071558Srgrimes(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@") 108102231Strhodes "*Where the `gnats' subdirectory containing category lists lives.") 1091558Srgrimes 110102231Strhodes(defvar send-pr::sites nil 1111558Srgrimes "List of GNATS support sites; computed at runtime.") 112102231Strhodes(defvar send-pr:default-site 1131558Srgrimes (or (gnats::get-config "GNATS_SITE") "freefall") 1141558Srgrimes "Default site to send bugs to.") 1151558Srgrimes(defvar send-pr:::site send-pr:default-site 11628458Ssteve "The site to which a problem report is currently being submitted, or NIL 1171558Srgrimesif using the default site (buffer local).") 1181558Srgrimes 11977575Sru(defvar send-pr:::categories nil 1201558Srgrimes "Buffer local list of available categories, derived at runtime from 1211558Srgrimessend-pr:::site and send-pr::category-alist.") 122102231Strhodes(defvar send-pr::category-alist nil 1231558Srgrimes "Alist of GNATS support sites and the categories supported at each; computed 1241558Srgrimesat runtime.") 12577575Sru 12663073Sdwmalone;;; Ideally we would get all the following values from a central database 12763073Sdwmalone;;; during runtime instead of having them here in the code. 12863073Sdwmalone;;; 1291558Srgrimes(defconst send-pr::fields 130102231Strhodes (` (("Category" send-pr::set-categories 1311558Srgrimes (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum) 1321558Srgrimes ("Class" (("sw-bug") ("doc-bug") ("change-request") ("wish")) 133113220Smdodd (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 0)) enum) 134115162Sru ("Confidential" (("yes") ("no")) 135115162Sru (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum) 136113220Smdodd ("Severity" (("non-critical") ("serious") ("critical")) 137115162Sru (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum) 138115162Sru ("Priority" (("low") ("medium") ("high")) 139115162Sru (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum) 140113224Smdodd ("Release" nil 141126569Sbrueffer (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@")) 142113224Smdodd text) 143113224Smdodd ("Submitter-Id" nil 144115162Sru (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) 145113224Smdodd text) 146113220Smdodd ("Synopsis" nil nil text 1471558Srgrimes (lambda (a b c) (gnats::set-mail-field "Subject" c))))) 1481558Srgrimes "AList, keyed on the name of the field, of: 1491558Srgrimes1) The field name. 150102231Strhodes2) The list of completions. This can be a list, a function to call, or nil. 1511558Srgrimes3) The default value. 1521558Srgrimes4) The type of the field. 1531558Srgrimes5) A sub-function to call when changed.") 1541558Srgrimes 155274858Strasz(defvar gnats::fields nil) 1561558Srgrimes 1571558Srgrimes(defmacro gnats::push (i l) 1581558Srgrimes (` (setq (, l) (cons (,@ (list i l)))))) 15928458Ssteve 16099503Scharnier(defun send-pr::set-categories (&optional arg) 1611558Srgrimes "Get the list of categories for the current site out of 162send-pr::category-alist if there or from send-pr if not. With arg, force 163update." 164 ;; 165 (let ((entry (assoc send-pr:::site send-pr::category-alist))) 166 (or (and entry (null arg)) 167 (let ((oldpr (getenv "GNATS_ROOT")) cats) 168 (send-pr::set-sites arg) 169 (setenv "GNATS_ROOT" gnats:root) 170 (setq cats (gnats::get-value-from-shell 171 "send-pr" "-CL" send-pr:::site)) 172 (setenv "GNATS_ROOT" oldpr) 173 (if entry (setcdr entry cats) 174 (setq entry (cons send-pr:::site cats)) 175 (gnats::push entry send-pr::category-alist)))) 176 (setq send-pr:::categories (cdr entry)))) 177 178(defun send-pr::set-sites (&optional arg) 179 "Get the list of sites (by listing the contents of DATADIR/gnats) and assign 180it to send-pr::sites. With arg, force update." 181 (or (and (null arg) send-pr::sites) 182 (progn 183 (setq send-pr::sites nil) 184 (mapcar 185 (function 186 (lambda (file) 187 (or (memq t (mapcar (function (lambda (x) (string= x file))) 188 '("." ".." "pr-edit" "pr-addr"))) 189 (not (file-readable-p file)) 190 (gnats::push (list (file-name-nondirectory file)) 191 send-pr::sites)))) 192 (directory-files (format "%s/gnats" send-pr:datadir) t)) 193 (setq send-pr::sites (reverse send-pr::sites))))) 194 195(defconst send-pr::pr-buffer-name "*send-pr*" 196 "Name of the temporary buffer, where the problem report gets composed.") 197 198(defconst send-pr::err-buffer-name "*send-pr-error*" 199 "Name of the temporary buffer, where send-pr error messages appear.") 200 201(defvar send-pr:::err-buffer nil 202 "The error buffer used by the current PR buffer.") 203 204(defconst gnats::indent 17 "Indent for formatting the value.") 205 206;;;;--------------------------------------------------------------------------- 207;;;; `send-pr' - command for creating and sending of problem reports 208;;;;--------------------------------------------------------------------------- 209 210(fset 'send-pr 'send-pr:send-pr) 211(defun send-pr:send-pr (&optional site) 212 "Create a buffer and read in the result of `send-pr -P'. 213When finished with editing the problem report use \\[send-pr:submit-pr] 214to send the PR with `send-pr -b -f -'." 215 ;; 216 (interactive 217 (if current-prefix-arg 218 (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t 219 send-pr:default-site)))) 220 (or site (setq site send-pr:default-site)) 221 (let ((buf (get-buffer send-pr::pr-buffer-name))) 222 (if (or (not buf) 223 (progn (switch-to-buffer buf) 224 (cond ((or (not (buffer-modified-p buf)) 225 (y-or-n-p "Erase previous problem report? ")) 226 (erase-buffer) t) 227 (t nil)))) 228 (send-pr::start-up site)))) 229 230(defun send-pr::start-up (site) 231 (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name)) 232 (setq default-directory (expand-file-name "~/")) 233 (auto-save-mode auto-save-default) 234 (let ((oldpr (getenv "GNATS_ROOT")) 235 (case-fold-search nil)) 236 (setenv "GNATS_ROOT" gnats:root) 237 (shell-command (concat "send-pr -P " site) t) 238 (setenv "GNATS_ROOT" oldpr) 239 (if (looking-at "send-pr:") 240 (cond ((looking-at "send-pr: .* does not have a categories list") 241 (setq send-pr::sites nil) 242 (error "send-pr: the GNATS site %s does not have a categories list" site)) 243 (t (error (buffer-substring (point-min) (point-max))))) 244 (save-excursion 245 ;; Clear cruft inserted by bdamaged .cshrcs 246 (re-search-forward "^SEND-PR:") 247 (delete-region 1 (match-beginning 0))))) 248 (set-buffer-modified-p nil) 249 (send-pr:send-pr-mode) 250 (setq send-pr:::site site) 251 (send-pr::set-categories) 252 (if (null send-pr:::categories) 253 (progn 254 (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer)) 255 (kill-buffer nil) 256 (message "send-pr: no categories found")) 257 (and mail-default-reply-to 258 (gnats::set-mail-field "Reply-To" mail-default-reply-to)) 259 (and mail-self-blind 260 (gnats::set-mail-field "BCC" (user-login-name))) 261 (mapcar 'send-pr::maybe-change-field send-pr::fields) 262 (gnats::position-on-field "Description") 263 (message (substitute-command-keys 264 "To send the problem report use: \\[send-pr:submit-pr]")))) 265 266(fset 'do-send-pr 'send-pr:submit-pr) ;backward compat 267(defun send-pr:submit-pr () 268 "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this 269buffer was loaded with emacsclient, in which case save the buffer and exit." 270 ;; 271 (interactive) 272 (cond 273 ((and (boundp 'server-buffer-clients) 274 server-buffer-clients) 275 (let ((buffer (current-buffer)) 276 (version-control nil) (buffer-backed-up nil)) 277 (save-buffer buffer) 278 (kill-buffer buffer) 279 (server-buffer-done buffer))) 280 (t 281 (or (and send-pr:::err-buffer 282 (buffer-name send-pr:::err-buffer)) 283 (setq send-pr:::err-buffer 284 (get-buffer-create send-pr::err-buffer-name))) 285 (let ((err-buffer send-pr:::err-buffer) mesg ok) 286 (save-excursion (set-buffer err-buffer) (erase-buffer)) 287 (message "running send-pr...") 288 (let ((oldpr (getenv "GNATS_ROOT"))) 289 (setenv "GNATS_ROOT" gnats:root) 290 (call-process-region (point-min) (point-max) "send-pr" 291 nil err-buffer nil send-pr:::site 292 "-b" "-f" "-") 293 (setenv "GNATS_ROOT" oldpr)) 294 (message "running send-pr...done") 295 ;; stupidly we cannot check the return value in EMACS 18.57, thus we need 296 ;; this kluge to find out whether send-pr succeeded. 297 (if (save-excursion 298 (set-buffer err-buffer) 299 (goto-char (point-min)) 300 (setq mesg (buffer-substring (point-min) (- (point-max) 1))) 301 (search-forward "problem report sent" nil t)) 302 (progn (message mesg) 303 (kill-buffer err-buffer) 304 (delete-auto-save-file-if-necessary) 305 (set-buffer-modified-p nil) 306 (bury-buffer)) 307 (pop-to-buffer err-buffer)) 308 )))) 309 310;;;;--------------------------------------------------------------------------- 311;;;; send-pr:send-pr-mode mode 312;;;;--------------------------------------------------------------------------- 313 314(defvar send-pr-mode-map 315 (let ((map (make-sparse-keymap))) 316 (define-key map "\C-c\C-c" 'send-pr:submit-pr) 317 (define-key map "\C-c\C-f" 'gnats:change-field) 318 (define-key map "\M-n" 'gnats:next-field) 319 (define-key map "\M-p" 'gnats:previous-field) 320 (define-key map "\C-\M-f" 'gnats:forward-field) 321 (define-key map "\C-\M-b" 'gnats:backward-field) 322 map) 323 "Keymap for send-pr mode.") 324 325(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):") 326(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):") 327(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+") 328 329(fset 'send-pr-mode 'send-pr:send-pr-mode) 330(defun send-pr:send-pr-mode () 331 "Major mode for submitting problem reports. 332For information about the form see gnats(1) and send-pr(1). 333Special commands: \\{send-pr-mode-map} 334Turning on send-pr-mode calls the value of the variable send-pr-mode-hook, 335if it is not nil." 336 (interactive) 337 (gnats::patch-exec-path) 338 (put 'send-pr:send-pr-mode 'mode-class 'special) 339 (kill-all-local-variables) 340 (setq major-mode 'send-pr:send-pr-mode) 341 (setq mode-name "send-pr") 342 (use-local-map send-pr-mode-map) 343 (set-syntax-table text-mode-syntax-table) 344 (setq local-abbrev-table text-mode-abbrev-table) 345 (setq buffer-offer-save t) 346 (make-local-variable 'send-pr:::site) 347 (make-local-variable 'send-pr:::categories) 348 (make-local-variable 'send-pr:::err-buffer) 349 (make-local-variable 'paragraph-separate) 350 (setq paragraph-separate (concat (default-value 'paragraph-separate) 351 "\\|" gnats::keyword "[ \t\n\f]*$")) 352 (make-local-variable 'paragraph-start) 353 (setq paragraph-start (concat (default-value 'paragraph-start) 354 "\\|" gnats::keyword)) 355 (run-hooks 'send-pr-mode-hook) 356 t) 357 358;;;;--------------------------------------------------------------------------- 359;;;; Functions to read and replace field values. 360;;;;--------------------------------------------------------------------------- 361 362(defun gnats::position-on-field (field) 363 (goto-char (point-min)) 364 (if (not (re-search-forward (concat "^>" field ":") nil t)) 365 (error "Field `>%s:' not found." field) 366 (re-search-forward "[ \t\n\f]*") 367 (if (looking-at gnats::keyword) 368 (backward-char 1)) 369 t)) 370 371(defun gnats::mail-position-on-field (field) 372 (let (end 373 (case-fold-search t)) 374 (goto-char (point-min)) 375 (re-search-forward "^$") 376 (setq end (match-beginning 0)) 377 (goto-char (point-min)) 378 (if (not (re-search-forward (concat "^" field ":") end 'go-to-end)) 379 (insert field ": \n") 380 (re-search-forward "[ \t\n\f]*")) 381 (skip-chars-backward "\n") 382 t)) 383 384(defun gnats::field-contents (field &optional elem move) 385 (let (pos) 386 (unwind-protect 387 (save-excursion 388 (if (not (gnats::position-on-field field)) 389 nil 390 (setq pos (point-marker)) 391 (if (or (looking-at "<.*>$") (eolp)) 392 t 393 (looking-at ".*$") ; to set match-{beginning,end} 394 (gnats::nth-word 395 (buffer-substring (match-beginning 0) (match-end 0)) 396 elem)))) 397 (and move pos (goto-char pos))))) 398 399(defun gnats::functionp (thing) 400 (or (and (symbolp thing) (fboundp thing)) 401 (and (listp thing) (eq (car thing) 'lambda)))) 402 403(defun gnats::field-values (field) 404 "Return the possible (known) values for field FIELD." 405 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 406 send-pr::fields)) 407 (thing (elt (assoc field fields) 1))) 408 (cond ((gnats::functionp thing) (funcall thing)) 409 ((listp thing) thing) 410 (t (error "ACK"))))) 411 412(defun gnats::field-default (field) 413 "Return the default value for field FIELD." 414 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 415 send-pr::fields)) 416 (thing (elt (assoc field fields) 2))) 417 (cond ((stringp thing) thing) 418 ((null thing) "") 419 ((numberp thing) (car (elt (gnats::field-values field) thing))) 420 ((gnats::functionp thing) 421 (funcall thing (gnats::field-contents field))) 422 ((eq thing t) (gnats::field-contents field)) 423 (t (error "ACK"))))) 424 425(defun gnats::field-type (field) 426 "Return the type of field FIELD." 427 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 428 send-pr::fields)) 429 (thing (elt (assoc field fields) 3))) 430 thing)) 431 432(defun gnats::field-action (field) 433 "Return the extra handling function for field FIELD." 434 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 435 send-pr::fields)) 436 (thing (elt (assoc field fields) 4))) 437 (cond ((null thing) 'ignore) 438 ((gnats::functionp thing) thing) 439 (t (error "ACK"))))) 440 441;;;;--------------------------------------------------------------------------- 442;;;; Point movement functions 443;;;;--------------------------------------------------------------------------- 444 445(or (fboundp 'defsubst) (fset 'defsubst 'defun)) 446 447(defun send-pr::maybe-change-field (field) 448 (setq field (car field)) 449 (let ((thing (gnats::field-contents field))) 450 (and thing (eq t thing) 451 (not (eq 'multi-text (gnats::field-type field))) 452 (gnats:change-field field)))) 453 454(defun gnats:change-field (&optional field default) 455 "Change the value of the field containing the cursor. With arg, ask the 456user for the field to change. From a program, the function takes optional 457arguments of the field to change and the default value to use." 458 (interactive) 459 (or field current-prefix-arg (setq field (gnats::current-field))) 460 (or field 461 (setq field 462 (completing-read "Field: " 463 (if (eq major-mode 'gnats:gnats-mode) 464 gnats::fields 465 send-pr::fields) 466 nil t))) 467 (gnats::position-on-field field) 468 (sit-for 0) 469 (let* ((old (gnats::field-contents field)) 470 new) 471 (if (null old) 472 (error "ACK") 473 (let ((prompt (concat ">" field ": ")) 474 (domain (gnats::field-values field)) 475 (type (gnats::field-type field)) 476 (action (gnats::field-action field))) 477 (or default (setq default (gnats::field-default field))) 478 (setq new (if (eq type 'enum) 479 (completing-read prompt domain nil t 480 (if gnats::emacs-19p (cons default 0) 481 default)) 482 (read-string prompt (if gnats::emacs-19p (cons default 1) 483 default)))) 484 (gnats::set-field field new) 485 (funcall action field old new) 486 new)))) 487 488(defun gnats::set-field (field value) 489 (save-excursion 490 (gnats::position-on-field field) 491 (delete-horizontal-space) 492 (looking-at ".*$") 493 (replace-match 494 (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t))) 495 496(defun gnats::set-mail-field (field value) 497 (save-excursion 498 (gnats::mail-position-on-field field) 499 (delete-horizontal-space) 500 (looking-at ".*$") 501 (replace-match (concat " " value) t))) 502 503(defun gnats::before-keyword (&optional where) 504 "Returns t if point is in some white space before a keyword. 505If where is nil, then point is not changed; if where is t then point is moved 506to the beginning of the keyword, otherwise it is moved to the beginning 507of the white space it was in." 508 ;; 509 (if (looking-at gnats::before-keyword) 510 (prog1 t 511 (cond ((eq where t) 512 (re-search-forward "^>") (backward-char)) 513 ((not (eq where nil)) 514 (re-search-backward "[^ \t\n\f]") (forward-char)))) 515 nil)) 516 517(defun gnats::after-keyword (&optional where) 518 "Returns t if point is in some white space after a keyword. 519If where is nil, then point is not changed; if where is t then point is moved 520to the beginning of the keyword, otherwise it is moved to the end of the white 521space it was in." 522 ;; 523 (if (gnats::looking-after gnats::after-keyword) 524 (prog1 t 525 (cond ((eq where t) 526 (re-search-backward "^>")) 527 ((not (eq where nil)) 528 (re-search-forward "[^ \t\n\f]") (backward-char)))) 529 nil)) 530 531(defun gnats::in-keyword (&optional where) 532 "Returns t if point is within a keyword. 533If where is nil, then point is not changed; if where is t then point is moved 534to the beginning of the keyword." 535 ;; 536 (let ((old-point (point-marker))) 537 (beginning-of-line) 538 (cond ((and (looking-at gnats::keyword) 539 (< old-point (match-end 0))) 540 (prog1 t 541 (if (eq where t) 542 t 543 (goto-char old-point)))) 544 (t (goto-char old-point) 545 nil)))) 546 547(defun gnats::forward-bofield () 548 "Moves point to the beginning of a field. Assumes that point is in the 549keyword." 550 ;; 551 (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-) 552 (backward-char) 553 t)) 554 555(defun gnats::backward-eofield () 556 "Moves point to the end of a field. Assumes point is in the keyword." 557 ;; 558 (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-) 559 (forward-char) 560 t)) 561 562(defun gnats::forward-eofield () 563 "Moves point to the end of a field. Assumes that point is in the field." 564 ;; 565 ;; look for the next field 566 (if (re-search-forward gnats::keyword (point-max) '-) 567 (progn (beginning-of-line) (gnats::backward-eofield)) 568 (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-) 569 (forward-char))) 570 571(defun gnats::backward-bofield () 572 "Moves point to the beginning of a field. Assumes that point is in the 573field." 574 ;; 575 ;;look for previous field 576 (if (re-search-backward gnats::keyword (point-min) '-) 577 (gnats::forward-bofield) 578 t)) 579 580 581(defun gnats:forward-field () 582 "Move point forward to the end of the field or to the beginning of the next 583field." 584 ;; 585 (interactive) 586 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 587 (gnats::after-keyword t)) 588 (gnats::forward-bofield) 589 (gnats::forward-eofield))) 590 591(defun gnats:backward-field () 592 "Move point backward to the beginning/end of a field." 593 ;; 594 (interactive) 595 (backward-char) 596 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 597 (gnats::after-keyword t)) 598 (gnats::backward-eofield) 599 (gnats::backward-bofield))) 600 601(defun gnats:next-field () 602 "Move point to the beginning of the next field." 603 ;; 604 (interactive) 605 (if (or (gnats::before-keyword t) (gnats::in-keyword t) 606 (gnats::after-keyword t)) 607 (gnats::forward-bofield) 608 (if (re-search-forward gnats::keyword (point-max) '-) 609 (gnats::forward-bofield) 610 t))) 611 612(defun gnats:previous-field () 613 "Move point to the beginning of the previous field." 614 ;; 615 (interactive) 616 (backward-char) 617 (if (or (gnats::after-keyword t) (gnats::in-keyword t) 618 (gnats::before-keyword t)) 619 (progn (re-search-backward gnats::keyword (point-min) '-) 620 (gnats::forward-bofield)) 621 (gnats::backward-bofield))) 622 623(defun gnats:beginning-of-field () 624 "Move point to the beginning of the current field." 625 (interactive) 626 (cond ((gnats::in-keyword t) 627 (gnats::forward-bofield)) 628 ((gnats::after-keyword 0)) 629 (t 630 (gnats::backward-bofield)))) 631 632(defun gnats::current-field () 633 (save-excursion 634 (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t)) 635 (looking-at gnats::keyword)) 636 ((re-search-backward gnats::keyword nil t))) 637 (buffer-substring (match-beginning 1) (match-end 1)) 638 nil))) 639 640;;;;--------------------------------------------------------------------------- 641;;;; Support functions 642;;;;--------------------------------------------------------------------------- 643 644(defun gnats::looking-after (regex) 645 "Returns t if point is after regex." 646 ;; 647 (let* ((old-point (point)) 648 (start (if (eobp) 649 old-point 650 (forward-char) (point)))) 651 (cond ((re-search-backward regex (point-min) t) 652 (goto-char old-point) 653 (cond ((eq (match-end 0) start) 654 t)))))) 655 656(defun gnats::nth-word (string &optional elem) 657 "Returns the elem-th word of the string. 658If elem is nil, then the first wort is returned, if elem is 0 then 659the whole string is returned." 660 ;; 661 (if (integerp elem) 662 (cond ((eq elem 0) string) 663 ((eq elem 1) (gnats::first-word string)) 664 ((equal string "") "") 665 ((>= elem 2) 666 (let ((i 0) (value "")) 667 (setq string ; strip leading blanks 668 (substring string (or (string-match "[^ \t]" string) 0))) 669 (while (< i elem) 670 (setq value 671 (substring string 0 672 (string-match "[ \t]*$\\|[ \t]+" string))) 673 (setq string 674 (substring string (match-end 0))) 675 (setq i (+ i 1))) 676 value))) 677 (gnats::first-word string))) 678 679(defun gnats::first-word (string) 680 (setq string 681 (substring string (or (string-match "[^ \t]" string) 0))) 682 (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string))) 683 684;;;;--------------------------------------------------------------------------- 685 686(defun gnats::patch-exec-path () 687 ;; 688 "Replaces `//' by `/' in `exec-path'." 689 ;; 690 ;(make-local-variable 'exec-path) 691 (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*")) 692 (ret)) 693 (setq exec-path (save-excursion (set-buffer err-buffer) 694 (prin1 exec-path err-buffer) 695 (goto-char (point-min)) 696 (replace-string "//" "/") 697 (goto-char (point-min)) 698 (setq ret (read err-buffer)) 699 (kill-buffer err-buffer) 700 ret 701 )))) 702 703(defun gnats::get-value-from-shell (&rest command) 704 "Execute shell command to get a list of valid values for `variable'." 705 ;; 706 (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*"))) 707 (save-excursion 708 (set-buffer err-buffer) 709 (unwind-protect 710 (condition-case var 711 (progn 712 (apply 'call-process 713 (car command) nil err-buffer nil (cdr command)) 714 (goto-char (point-min)) 715 (if (looking-at "[-a-z]+: ") 716 (error (buffer-substring (point-min) (point-max)))) 717 (read err-buffer)) 718 (error nil)) 719 (kill-buffer err-buffer))))) 720 721(or (fboundp 'setenv) 722 (defun setenv (variable &optional value) 723 "Set the value of the environment variable named VARIABLE to VALUE. 724VARIABLE should be a string. VALUE is optional; if not provided or is 725`nil', the environment variable VARIABLE will be removed. 726This function works by modifying `process-environment'." 727 (interactive "sSet environment variable: \nsSet %s to value: ") 728 (if (string-match "=" variable) 729 (error "Environment variable name `%s' contains `='" variable) 730 (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) 731 (case-fold-search nil) 732 (scan process-environment)) 733 (while scan 734 (cond 735 ((string-match pattern (car scan)) 736 (if (eq nil value) 737 (setq process-environment (delq (car scan) 738 process-environment)) 739 (setcar scan (concat variable "=" value))) 740 (setq scan nil)) 741 ((null (setq scan (cdr scan))) 742 (setq process-environment 743 (cons (concat variable "=" value) 744 process-environment))))))))) 745 746;;;; end of send-pr.el 747