~ubuntu-branches/ubuntu/raring/ess/raring-proposed : revision 9

7

8

;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.

9

10

;; ESS-related Changes for ESS added by Mark Lunt and A.J. Rossini,

11

;; starting March, 1999.

10

;; ESS-related Changes first added by Mark Lunt and A.J. Rossini, March, 1999.

12

11

13

12

;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>

14

13

68

67

;;

69

68

;; * [tho] noweb-goto-chunk proposes a default

70

69

;;

70

;; * commands for tangling, weaving,.. for Sweave: --> ./ess-swv.el

71

;;

71

72

73

;; TODO:

73

74

;;

74

;; * replace obscure hacks like `(stringp (car (noweb-find-chunk)))'

75

;; by something more reasonable like `(noweb-code-chunkp)'.

76

;;

77

75

;; * _maybe_ replace our `noweb-chunk-vector' by text properties. We

78

76

;; could then use highlighting to jazz up the visual appearance.

79

77

;; (Highlighting is sorted: `noweb-chunk-vector' can be

84

82

;;

85

83

;; * more range checks and error exits

86

84

;;

87

;; * commands for tangling, weaving, etc.

88

;;

89

85

;; * `noweb-hide-code-quotes' should be superfluous now, and could

90

86

;; be removed

91

;;

92

;; * ...

93

;;

87

88

89

;; Want to use these now in order to cater for all obscure kinds of emacsen

90

(eval-and-compile

91

(require 'ess-emcs))

92

94

93

95

94

96

95

;;; Variables

403

402

\\[noweb-describe-mode] \tdescribe noweb-mode

404

403

\\[noweb-mode-version] \t\tshow noweb-mode's version in the minibuffer

405

404

" (interactive "P")

406

; This bit is tricky: copied almost verbatim from bib-cite-mode.el

407

; It seems to ensure that the variable noweb-mode is made

408

; local to this buffer. It then sets noweb-mode to `t' if

409

; 1) It was called with an argument greater than 0

410

; or 2) It was called with no argument, and noweb-mode is

411

; currently nil

412

; noweb-mode is nil if the argument was <= 0 or there

413

; was no argument and noweb-mode is currently `t'

405

;; This bit is tricky: copied almost verbatim from bib-cite-mode.el

406

;; It seems to ensure that the variable noweb-mode is made

407

;; local to this buffer. It then sets noweb-mode to `t' if

408

;; 1) It was called with an argument greater than 0

409

;; or 2) It was called with no argument, and noweb-mode is

410

;; currently nil

411

;; noweb-mode is nil if the argument was <= 0 or there

412

;; was no argument and noweb-mode is currently `t'

413

(kill-all-local-variables)

414

(set (make-local-variable 'noweb-mode)

415

(if arg

416

(> (prefix-numeric-value arg) 0)

417

(not noweb-mode)))

418

; Now, if noweb-mode is true, we want to turn

419

; noweb-mode on

418

;; Now, if noweb-mode is true, we want to turn

419

;; noweb-mode on

420

(cond

421

(noweb-mode ;Setup the minor-mode

421

(noweb-mode ;Setup the minor-mode

422

(mapcar 'noweb-make-variable-permanent-local

423

'(noweb-mode

424

after-change-functions

425

before-change-functions

425

426

noweb-narrowing

426

427

noweb-chunk-vector

427

428

post-command-hook

438

439

(if font-lock-mode

439

440

(progn

440

441

(font-lock-mode -1)

442

(require 'noweb-font-lock-mode); which requires noweb-mode .. hmm..

441

443

(noweb-font-lock-mode 1)))

442

444

(add-hook 'post-command-hook 'noweb-post-command-function)

443

(add-hook 'after-change-functions 'noweb-after-change-function)

445

446

(when (or (<= emacs-major-version 20)

447

(featurep 'xemacs)) ;; Xemacs or very old GNU Emacs

448

(make-local-hook 'after-change-functions)

449

(make-local-hook 'before-change-functions))

450

(add-hook 'after-change-functions 'noweb-after-change-function nil t)

451

(add-hook 'before-change-functions 'noweb-before-change-function nil t)

452

444

453

(add-hook 'noweb-select-doc-mode-hook 'noweb-auto-fill-doc-mode)

445

454

(add-hook 'noweb-select-code-mode-hook 'noweb-auto-fill-code-mode)

446

455

(add-hook 'isearch-mode-hook 'noweb-note-isearch-mode)

453

462

;; off, no matter what (hence the condition `t')

454

463

(t

455

464

(remove-hook 'post-command-hook 'noweb-post-command-function)

456

(remove-hook 'after-change-functions 'noweb-after-change-function)

465

466

(if (fboundp 'remove-local-hook)

467

(progn

468

(remove-local-hook 'after-change-functions 'noweb-after-change-function)

469

(remove-local-hook 'before-change-functions 'noweb-before-change-function))

470

(remove-hook 'after-change-functions 'noweb-after-change-function t)

471

(remove-hook 'before-change-functions 'noweb-before-change-function t))

472

457

473

(remove-hook 'noweb-select-doc-mode-hook 'noweb-auto-fill-doc-mode)

458

474

(remove-hook 'noweb-select-code-mode-hook 'noweb-auto-fill-code-mode)

459

475

(remove-hook 'isearch-mode-hook 'noweb-note-isearch-mode)

460

476

(remove-hook 'isearch-mode-end-hook 'noweb-note-isearch-mode-end)

461

(if noweb-font-lock-mode

477

(if (and (boundp 'noweb-font-lock-mode)

478

noweb-font-lock-mode)

462

479

(progn

463

480

(noweb-font-lock-mode -1)

464

481

(message "Noweb and Noweb-Font-Lock Modes Removed"))

482

499

"The hook being run after each command in noweb mode."

483

500

(noweb-select-mode))

484

501

502

(defvar noweb-chunk-boundary-changed nil

503

"Whether the current change affects a chunk boundary.")

504

505

(defvar noweb-chunk-boundary-regexp "^\$@[^@]\$\\|\$<<\$")

506

507

(defun noweb-before-change-function (begin end)

508

"Record changes to chunk boundaries."

509

(save-excursion

510

(goto-char begin)

511

(setq noweb-chunk-boundary-changed

512

(re-search-forward noweb-chunk-boundary-regexp end t))))

513

485

514

(defun noweb-after-change-function (begin end length)

486

515

"Function to run after every change in a noweb buffer.

487

If the changed region contains a chunk start (^@ or ^<<), it will

488

update the chunk vector"

516

If the changed region contains a chunk boundary, it will update

517

the chunk vector"

489

518

(save-excursion

490

519

(goto-char begin)

491

(if (re-search-forward "^\$@[^@]\$\\|\$<<\$" end t)

492

(noweb-update-chunk-vector))))

520

(when (or noweb-chunk-boundary-changed

521

(re-search-forward noweb-chunk-boundary-regexp end t))

522

(noweb-update-chunk-vector)

523

(setq noweb-chunk-boundary-changed nil))))

493

524

494

525

495

526

;;; Chunks

521

552

;; Scan forward either to !/^@ %def/, which will start a docs chunk,

522

553

;; or to /^<<.*>>=$/, which will start a code chunk.

523

554

(progn

524

(next-line 1)

555

(forward-line 1)

525

556

(while (looking-at "@ %def")

526

(next-line 1))

557

(forward-line 1))

527

558

(setq chunk-list

528

559

;; Now we can tell code vs docs

529

560

(cons (cons (if (looking-at "<<\$.*\$>>=")

532

563

'doc)

533

564

(point-marker))

534

565

chunk-list))))

535

(next-line 1))

566

(forward-line 1))

536

567

(setq chunk-list (cons (cons 'doc (point-max-marker)) chunk-list))

537

568

(setq noweb-chunk-vector (vconcat (reverse chunk-list))))))

538

569

680

711

(defun noweb-chunk-vector-aref (i)

681

712

(if (< i 0)

682

713

(error "Before first chunk."))

714

(if (not noweb-chunk-vector)

715

(noweb-update-chunk-vector))

683

716

(if (>= i (length noweb-chunk-vector))

684

717

(error "Beyond last chunk."))

685

718

(aref noweb-chunk-vector i))

689

722

(interactive)

690

723

(if (noweb-in-code-chunk)

691

724

(let ((end (point))

692

(beg (save-excursion

693

(if (re-search-backward "<<"

694

(save-excursion

695

(beginning-of-line)

696

(point))

697

t)

698

(match-end 0)

699

nil))))

725

(beg (save-excursion

726

(if (re-search-backward "<<"

727

(save-excursion

728

(beginning-of-line)

729

(point))

730

t)

731

(match-end 0)

732

nil))))

700

733

(if beg

701

734

(let* ((pattern (buffer-substring beg end))

702

735

(alist (noweb-build-chunk-alist))

809

842

(interactive)

810

843

(save-restriction

811

844

(noweb-narrow-to-chunk)

812

(if (stringp (car (noweb-find-chunk)))

845

(if (noweb-in-code-chunk)

813

846

(progn

814

847

;; Narrow to the code section proper; w/o the first and any

815

848

;; index declaration lines.

834

867

(save-excursion

835

868

(save-restriction

836

869

(noweb-narrow-to-chunk)

837

(if (stringp (car (noweb-find-chunk)))

870

(if (noweb-in-code-chunk)

838

871

(progn

839

872

;; Narrow to the code section proper; w/o the first and any

840

873

;; index declaration lines.

985

1018

(setq start (+ (noweb-sign cnt) start)))

986

1019

(setq i (1+ i)))

987

1020

(goto-char (marker-position (cdr (noweb-chunk-vector-aref start))))

988

(next-line 1))

1021

(forward-line 1))

989

1022

(if noweb-narrowing

990

1023

(noweb-narrow-to-chunk-pair)))

991

1024

1079

1112

(setq i (1+ i)))

1080

1113

(goto-char (marker-position

1081

1114

(cdr (noweb-chunk-vector-aref start))))

1082

(next-line 1))))

1115

(forward-line 1))))

1083

1116

(if noweb-narrowing

1084

1117

(noweb-narrow-to-chunk-pair)))

1085

1118

1146

1179

"Smart incarnation of `<', starting a new code chunk, maybe.

1147

1180

If given an numerical argument, it will act just like the dumb `<'.

1148

1181

Otherwise and if at the beginning of a line in a documentation chunk:

1149

insert \"<<>>=\" and a newline if necessary. Leave point in the middle

1150

and and update the chunk vector."

1182

insert \"<<>>=\", a closing \"@\" and a newline if necessary. Leave point

1183

in the middle and and update the chunk vector."

1151

1184

(interactive "P")

1152

1185

(if arg

1153

1186

(self-insert-command (if (numberp arg) arg 1))

1154

1187

(if (and (noweb-at-beginning-of-line)

1155

(not (stringp (car (noweb-find-chunk)))))

1188

(not (noweb-in-code-chunk)))

1156

1189

(progn

1157

1190

(insert "<<")

1158

1191

(save-excursion

1159

(insert ">>=")

1192

(insert ">>=\n@ ")

1160

1193

(if (not (looking-at "\\s *$"))

1161

1194

(newline)))

1162

1195

(noweb-update-chunk-vector))

1661

1694

(goto-char (point-min))

1662

1695

(while (re-search-forward thread-name-re nil t)

1663

1696

(noweb-tangle-chunk tangle-buffer pre-chunk)

1664

(next-line 1)))

1697

(forward-line 1)))

1665

1698

(if post-chunk

1666

1699

(save-excursion

1667

1700

(set-buffer tangle-buffer)