|
Lines 357-362
Optional argument LIMIT restarts collection after that number of elements."
Link Here
|
| 357 |
"Major mode for the log buffer of `ebuild-run-command'. |
357 |
"Major mode for the log buffer of `ebuild-run-command'. |
| 358 |
If nil, `compilation-mode' will be used.") |
358 |
If nil, `compilation-mode' will be used.") |
| 359 |
|
359 |
|
|
|
360 |
(eval-when-compile |
| 361 |
(defmacro emacs-ecase (&rest clauses) |
| 362 |
"Dispatch on emacs version with ecase-like syntax at compile-time." |
| 363 |
(declare (indent 0)) |
| 364 |
(let* ((sublist clauses) (body nil) (version-spec nil) (no-match t) |
| 365 |
result) |
| 366 |
(while |
| 367 |
(and sublist |
| 368 |
(progn |
| 369 |
(setq body (car sublist) |
| 370 |
version-spec (pop body)) |
| 371 |
(if (eval (cond |
| 372 |
((eq 'otherwise version-spec) |
| 373 |
(error |
| 374 |
"‘otherwise’-clauses are not allowed in ecase")) |
| 375 |
((eq 'xemacs version-spec) `(featurep 'xemacs)) |
| 376 |
((numberp version-spec) |
| 377 |
`(= ,version-spec emacs-major-version)) |
| 378 |
((and (consp version-spec) |
| 379 |
(numberp (car version-spec)) |
| 380 |
(numberp (cdr version-spec))) |
| 381 |
`(<= ,(car version-spec) |
| 382 |
emacs-major-version |
| 383 |
,(cdr version-spec))) |
| 384 |
((memq (car version-spec) '(> < >= <= = ≥ ≤)) |
| 385 |
`(,(car version-spec) |
| 386 |
emacs-major-version |
| 387 |
,@(cdr version-spec))) |
| 388 |
(t (error "Unrecognised emacs version-spec %s" |
| 389 |
version-spec)))) |
| 390 |
(setq result (if (cdr body) `(progn ,@body) |
| 391 |
(car body)) |
| 392 |
no-match nil) |
| 393 |
t))) |
| 394 |
(pop sublist)) |
| 395 |
(if no-match |
| 396 |
(error "emacs-ecase failed: emacs version does not match %s" |
| 397 |
(mapcar #'car clauses)) |
| 398 |
result)))) |
| 399 |
|
| 400 |
(emacs-ecase |
| 401 |
;; We must require tramp separately |
| 402 |
;; so that with-parsed-tramp-file-name can be macroexpanded in the next form. |
| 403 |
(xemacs) |
| 404 |
((< 24)) |
| 405 |
((>= 24) (require 'tramp))) |
| 406 |
|
| 407 |
(emacs-ecase |
| 408 |
(xemacs) |
| 409 |
((< 24)) |
| 410 |
((>= 24) |
| 411 |
(defcustom ebuild-run-as-portage-or-root nil |
| 412 |
"When non-nil, adjust user of `ebuild-run-command': |
| 413 |
|
| 414 |
Run as root: merge, install, postinst, preinst, |
| 415 |
unmerge, postrm, prerm, |
| 416 |
config, package, qmerge |
| 417 |
|
| 418 |
Run as current user: manifest, digest, help |
| 419 |
|
| 420 |
Run as portage: (everything else)" |
| 421 |
:type 'boolean |
| 422 |
:group 'ebuild) |
| 423 |
|
| 424 |
(emacs-ecase |
| 425 |
((24 . 25) |
| 426 |
(defconst ebuild-run-tramp-method "sudo" |
| 427 |
"Tramp method to employ for the user adjustment |
| 428 |
enabled by `ebuild-run-as-portage-or-root'. |
| 429 |
|
| 430 |
Not supposed to be customized in this version of GNU Emacs")) |
| 431 |
((>= 26) |
| 432 |
(defcustom ebuild-run-tramp-method "sudo" |
| 433 |
"Tramp method to employ for the user adjustment |
| 434 |
enabled by `ebuild-run-as-portage-or-root'." |
| 435 |
:type '(choice (const "sudo") (const "doas")) |
| 436 |
:group 'ebuild))) |
| 437 |
|
| 438 |
(defun ebuild--run-default-directory (command) |
| 439 |
"Return the value of `default-directory' most appropriate to |
| 440 |
conveniently run ebuild command COMMAND, presuming the ebuild |
| 441 |
script in question is located in (the current) |
| 442 |
`default-directory'. |
| 443 |
|
| 444 |
If `ebuild-run-as-portage-or-root' is nil, always return |
| 445 |
`default-directory'." |
| 446 |
(let ((root-commands '("merge" "install" "postinst" "preinst" |
| 447 |
"unmerge" "postrm" "prerm" |
| 448 |
;; TODO: Maybe rpm should be listed here too. |
| 449 |
"config" "package" "qmerge")) |
| 450 |
(default-user-commands '("manifest" "digest" "help"))) |
| 451 |
(cond ((or (not ebuild-run-as-portage-or-root) |
| 452 |
(member command default-user-commands)) |
| 453 |
default-directory) |
| 454 |
((not (tramp-tramp-file-p default-directory)) |
| 455 |
(concat "/" ebuild-run-tramp-method |
| 456 |
":" (if (member command root-commands) "root" |
| 457 |
"portage") |
| 458 |
"@" tramp-default-host |
| 459 |
":" default-directory)) |
| 460 |
(t |
| 461 |
(emacs-ecase |
| 462 |
((24 . 25) |
| 463 |
(with-parsed-tramp-file-name default-directory ebuild-dir |
| 464 |
(setf ebuild-dir-user |
| 465 |
(if (member command root-commands) "root" |
| 466 |
"portage")) |
| 467 |
(tramp-make-tramp-file-name ebuild-dir-method |
| 468 |
ebuild-dir-user |
| 469 |
ebuild-dir-host |
| 470 |
ebuild-dir-localname |
| 471 |
ebuild-dir-hop))) |
| 472 |
(26 |
| 473 |
(with-parsed-tramp-file-name default-directory ebuild-dir |
| 474 |
(setf ebuild-dir-user |
| 475 |
(if (member command root-commands) "root" |
| 476 |
"portage")) |
| 477 |
(tramp-make-tramp-file-name ebuild-dir-method |
| 478 |
ebuild-dir-user |
| 479 |
ebuild-dir-domain |
| 480 |
ebuild-dir-host |
| 481 |
ebuild-dir-port |
| 482 |
ebuild-dir-localname |
| 483 |
ebuild-dir-hop))) |
| 484 |
((> 26) |
| 485 |
(with-parsed-tramp-file-name default-directory ebuild-dir |
| 486 |
(setf (tramp-file-name-user ebuild-dir) |
| 487 |
(if (member command root-commands) "root" |
| 488 |
"portage")) |
| 489 |
(tramp-make-tramp-file-name ebuild-dir)))))))))) |
| 490 |
|
| 360 |
(defun ebuild-run-command (command) |
491 |
(defun ebuild-run-command (command) |
| 361 |
"Run ebuild COMMAND, with output to a compilation buffer." |
492 |
"Run ebuild COMMAND, with output to a compilation buffer." |
| 362 |
(interactive |
493 |
(interactive |
|
Lines 365-371
If nil, `compilation-mode' will be used.")
Link Here
|
| 365 |
nil t))) |
496 |
nil t))) |
| 366 |
(or (member command ebuild-commands-list) |
497 |
(or (member command ebuild-commands-list) |
| 367 |
(error "Ebuild command \"%s\" not known" command)) |
498 |
(error "Ebuild command \"%s\" not known" command)) |
| 368 |
(let* ((file (file-relative-name buffer-file-name)) |
499 |
(let* ((preserved-directory |
|
|
500 |
;; Preserve directory for more tidy command in the ebuild-run buffer |
| 501 |
default-directory) |
| 502 |
(default-directory (emacs-ecase |
| 503 |
(xemacs default-directory) |
| 504 |
((< 24) default-directory) |
| 505 |
((>= 24) (ebuild--run-default-directory |
| 506 |
command)))) |
| 507 |
(file (file-relative-name buffer-file-name preserved-directory)) |
| 369 |
(shell-command (format "ebuild %s %s" file command)) |
508 |
(shell-command (format "ebuild %s %s" file command)) |
| 370 |
(process-environment (cons "NOCOLOR=true" process-environment)) |
509 |
(process-environment (cons "NOCOLOR=true" process-environment)) |
| 371 |
;;(compilation-mode-hook (lambda () (setq truncate-lines t))) |
510 |
;;(compilation-mode-hook (lambda () (setq truncate-lines t))) |
| 372 |
- |
|
|
