Mercurial > emacs
changeset 110239:0e1427d10b77
Merge from mainline.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Tue, 31 Aug 2010 22:44:36 +0000 |
parents | 872e600cef62 (current diff) 1a236d9dcc23 (diff) |
children | 16b0300d6454 |
files | |
diffstat | 9 files changed, 233 insertions(+), 345 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/ChangeLog Tue Aug 31 22:44:36 2010 +0000 @@ -1,3 +1,27 @@ +2010-08-31 Masatake YAMATO <yamato@redhat.com> + + * textmodes/nroff-mode.el (nroff-view): New command. + (nroff-mode-map): Bind it to C-c C-c. + +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-down-list): New command. + + Remove old indentation and navigation code on octave-mode. + * progmodes/octave-mod.el (octave-mode-map): Remap down-list to + smie-down-list rather than add a binding for octave-down-block. + (octave-mark-block, octave-blink-matching-block-open): + Rely on forward-sexp-function. + (octave-fill-paragraph): Don't narrow, so you can use + indent-according-to-mode. + (octave-block-begin-regexp, octave-block-begin-or-end-regexp): Remove. + (octave-in-block-p, octave-re-search-forward-kw) + (octave-re-search-backward-kw, octave-indent-calculate) + (octave-end-as-array-index-p, octave-block-end-offset) + (octave-scan-blocks, octave-forward-block, octave-backward-block) + (octave-down-block, octave-backward-up-block, octave-up-block) + (octave-before-magic-comment-p, octave-indent-line): Remove. + 2010-08-31 Chong Yidong <cyd@stupidchicken.com> * emacs-lisp/package.el (package--read-archive-file): Just use @@ -12,15 +36,15 @@ package-menu-package-list and package-menu-package-sort-key. (package-menu--version-predicate): Fix version calculation. (package-menu-sort-by-column): Don't select the window. - (package--list-packages): Create the *Packages* buffer. Set - package-menu-package-list-key. + (package--list-packages): Create the *Packages* buffer. + Set package-menu-package-list-key. (list-packages): Sorting by status is now the default. (package-buffer-info): Use match-string-no-properties. (define-package): Add a &rest argument for future proofing, but don't use it yet. (package-install-from-buffer, package-install-buffer-internal): - Merged into a single function, package-install-from-buffer. - (package-install-file): Caller changed. + Merge into a single function, package-install-from-buffer. + (package-install-file): Change caller. * finder.el: Load finder-inf using `require'. (finder-list-matches): Sorting by status is now the default.
--- a/lisp/emacs-lisp/smie.el Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/emacs-lisp/smie.el Tue Aug 31 22:44:36 2010 +0000 @@ -560,6 +560,42 @@ (indent-according-to-mode) (reindent-then-newline-and-indent)))) +(defun smie-down-list (&optional arg) + "Move forward down one level paren-like blocks. Like `down-list'. +With argument ARG, do this that many times. +A negative argument means move backward but still go down a level. +This command assumes point is not in a string or comment." + (interactive "p") + (let ((start (point)) + (inc (if (< arg 0) -1 1)) + (offset (if (< arg 0) 1 0)) + (next-token (if (< arg 0) + smie-backward-token-function + smie-forward-token-function))) + (while (/= arg 0) + (setq arg (- arg inc)) + (while + (let* ((pos (point)) + (token (funcall next-token)) + (levels (assoc token smie-op-levels))) + (cond + ((zerop (length token)) + (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) + (looking-at "\\s(\\|\\s)")) + ;; Go back to `start' in case of an error. This presumes + ;; none of the token we've found until now include a ( or ). + (progn (goto-char start) (down-list inc) nil) + (forward-sexp inc) + (/= (point) pos))) + ((and levels (null (nth (+ 1 offset) levels))) nil) + ((and levels (null (nth (- 2 offset) levels))) + (let ((end (point))) + (goto-char start) + (signal 'scan-error + (list "Containing expression ends prematurely" + pos end)))) + (t))))))) + ;;; The indentation engine. (defcustom smie-indent-basic 4
--- a/lisp/gnus/ChangeLog Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/gnus/ChangeLog Tue Aug 31 22:44:36 2010 +0000 @@ -1,3 +1,12 @@ +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-html.el: Require packages that define macros used in this file. + (gnus-article-mouse-face): Declare to silence byte-compiler. + (gnus-html-curl-sentinel): Use with-current-buffer, inhibit-read-only, and + process-get. + (gnus-html-put-image): Use plist-get to avoid getf. + (gnus-html-prefetch-images): Use with-current-buffer. + 2010-08-31 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-sum.el (gnus-summary-stop-at-end-of-message) @@ -10,6 +19,9 @@ 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-html.el: require mm-url. + (gnus-html-wash-tags): Clarify the code a bit by renaming the variable + with the url to `url'. + (gnus-html-wash-tags): Support cid: URLs/images. 2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
--- a/lisp/gnus/gnus-ems.el Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/gnus/gnus-ems.el Tue Aug 31 22:44:36 2010 +0000 @@ -276,7 +276,7 @@ (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string " ")) + (insert-image glyph (or string "*")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point)
--- a/lisp/gnus/gnus-html.el Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/gnus/gnus-html.el Tue Aug 31 22:44:36 2010 +0000 @@ -28,6 +28,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'mm-decode)) (require 'mm-url) (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") @@ -71,8 +73,10 @@ "-T" "text/html")))) (gnus-html-wash-tags)))) +(defvar gnus-article-mouse-face) + (defun gnus-html-wash-tags () - (let (tag parameters string start end images) + (let (tag parameters string start end images url) (mm-url-decode-entities) (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) @@ -89,31 +93,46 @@ ;; Fetch and insert a picture. ((equal tag "img_alt") (when (string-match "src=\"\\([^\"]+\\)" parameters) - (setq parameters (match-string 1 parameters)) + (setq url (match-string 1 parameters)) (when (or (null mm-w3m-safe-url-regexp) - (string-match mm-w3m-safe-url-regexp parameters)) - (let ((file (gnus-html-image-id parameters))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (when (gnus-html-put-image file (point)) - ;; Delete the ALT text. - (delete-region start end)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list parameters - (set-marker (make-marker) start) - (point-marker)) - images)))))) + (string-match mm-w3m-safe-url-regexp url)) + (if (string-match "^cid:\\(.*\\)" url) + ;; URLs with cid: have their content stashed in other + ;; parts of the MIME structure, so just insert them + ;; immediately. + (let ((handle (mm-get-content-id + (setq url (match-string 1 url)))) + image) + (when handle + (mm-with-part handle + (setq image (gnus-create-image (buffer-string) + nil t)))) + (when image + (delete-region start end) + (gnus-put-image image))) + ;; Normal, external URL. + (let ((file (gnus-html-image-id url))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (when (gnus-html-put-image file (point)) + ;; Delete the ALT text. + (delete-region start end)) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (push (list url + (set-marker (make-marker) start) + (point-marker)) + images))))))) ;; Add a link. ((equal tag "a") (when (string-match "href=\"\\([^\"]+\\)" parameters) - (setq parameters (match-string 1 parameters)) + (setq url (match-string 1 parameters)) (gnus-article-add-button start end - 'browse-url parameters - parameters) + 'browse-url url + url) (let ((overlay (gnus-make-overlay start end))) (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'gnus-button-url parameters) + (gnus-overlay-put overlay 'gnus-button-url url) (when gnus-article-mouse-face (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; Whatever. Just ignore the tag. @@ -147,19 +166,18 @@ (defun gnus-html-curl-sentinel (process event) (when (string-match "finished" event) - (let* ((images (getf (process-plist process) 'images)) - (buffer (getf (process-plist process) 'buffer)) + (let* ((images (process-get process 'images)) + (buffer (process-get process 'buffer)) (spec (pop images)) (file (gnus-html-image-id (car spec)))) (when (and (buffer-live-p buffer) ;; If the position of the marker is 1, then that - ;; means that the text is was in has been deleted; + ;; means that the text it was in has been deleted; ;; i.e., that the user has selected a different ;; article before the image arrived. - (not (= (marker-position (cadr spec)) 1))) - (save-excursion - (set-buffer buffer) - (let ((buffer-read-only nil)) + (not (= (marker-position (cadr spec)) (point-min)))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) (when (gnus-html-put-image file (cadr spec)) (delete-region (1+ (cadr spec)) (caddr spec)))))) (when images @@ -175,7 +193,7 @@ ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. (not (and (listp image) - (eq (getf (cdr image) :type) 'gif) + (eq (plist-get (cdr image) :type) 'gif) (= (car (image-size image t)) 30) (= (cdr (image-size image t)) 30)))) (progn @@ -208,8 +226,7 @@ (defun gnus-html-prefetch-images (summary) (let (safe-url-regexp urls) (when (buffer-live-p summary) - (save-excursion - (set-buffer summary) + (with-current-buffer summary (setq safe-url-regexp mm-w3m-safe-url-regexp)) (save-match-data (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
--- a/lisp/progmodes/octave-mod.el Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/progmodes/octave-mod.el Tue Aug 31 22:44:36 2010 +0000 @@ -223,7 +223,7 @@ (define-key map "\C-c\C-n" 'octave-next-code-line) (define-key map "\C-c\C-a" 'octave-beginning-of-line) (define-key map "\C-c\C-e" 'octave-end-of-line) - (define-key map "\C-c\M-\C-d" 'octave-down-block) + (define-key map [remap down-list] 'smie-down-list) (define-key map "\C-c\M-\C-h" 'octave-mark-block) (define-key map "\C-c]" 'smie-close-block) (define-key map "\C-c/" 'smie-close-block) @@ -258,7 +258,6 @@ ["End of Continuation" octave-end-of-line t] ["Split Line at Point" octave-indent-new-comment-line t]) ("Blocks" - ["Down Block" octave-down-block t] ["Mark Block" octave-mark-block t] ["Close Block" smie-close-block t]) ("Functions" @@ -343,10 +342,6 @@ :type 'integer :group 'octave) -(defvar octave-block-begin-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-begin-keywords "\\|") - "\\)\\>")) (defvar octave-block-else-regexp (concat "\\<\\(" (mapconcat 'identity octave-else-keywords "\\|") @@ -355,8 +350,6 @@ (concat "\\<\\(" (mapconcat 'identity octave-end-keywords "\\|") "\\)\\>")) -(defvar octave-block-begin-or-end-regexp - (concat octave-block-begin-regexp "\\|" octave-block-end-regexp)) (defvar octave-block-else-or-end-regexp (concat octave-block-else-regexp "\\|" octave-block-end-regexp)) (defvar octave-block-match-alist @@ -723,36 +716,12 @@ (let ((pps (parse-partial-sexp (line-beginning-position) (point)))) (not (or (nth 3 pps) (nth 4 pps))))) -(defun octave-in-block-p () - "Return t if point is inside an Octave block. -The block is taken to start at the first letter of the begin keyword and -to end after the end keyword." - (let ((pos (point))) - (save-excursion - (condition-case nil - (progn - (skip-syntax-forward "w") - (octave-up-block -1) - (octave-forward-block) - t) - (error nil)) - (< pos (point))))) (defun octave-looking-at-kw (regexp) "Like `looking-at', but sets `case-fold-search' nil." (let ((case-fold-search nil)) (looking-at regexp))) -(defun octave-re-search-forward-kw (regexp count) - "Like `re-search-forward', but sets `case-fold-search' nil, and moves point." - (let ((case-fold-search nil)) - (re-search-forward regexp nil 'move count))) - -(defun octave-re-search-backward-kw (regexp count) - "Like `re-search-backward', but sets `case-fold-search' nil, and moves point." - (let ((case-fold-search nil)) - (re-search-backward regexp nil 'move count))) - (defun octave-maybe-insert-continuation-string () (if (or (octave-in-comment-p) (save-excursion @@ -764,108 +733,6 @@ ;;; Indentation -(defun octave-indent-calculate () - "Return appropriate indentation for current line as Octave code. -Returns an integer (the column to indent to) unless the line is a -comment line with fixed goal golumn. In that case, returns a list whose -car is the column to indent to, and whose cdr is the current indentation -level." - (let ((is-continuation-line - (save-excursion - (if (zerop (octave-previous-code-line)) - (looking-at octave-continuation-regexp)))) - (icol 0)) - (save-excursion - (beginning-of-line) - ;; If we can move backward out one level of parentheses, take 1 - ;; plus the indentation of that parenthesis. Otherwise, go back - ;; to the beginning of the previous code line, and compute the - ;; offset this line gives. - (if (condition-case nil - (progn - (up-list -1) - t) - (error nil)) - (setq icol (+ 1 (current-column))) - (if (zerop (octave-previous-code-line)) - (progn - (octave-beginning-of-line) - (back-to-indentation) - (setq icol (current-column)) - (let ((bot (point)) - (eol (line-end-position))) - (while (< (point) eol) - (if (octave-not-in-string-or-comment-p) - (cond - ((octave-looking-at-kw "\\<switch\\>") - (setq icol (+ icol (* 2 octave-block-offset)))) - ((octave-looking-at-kw octave-block-begin-regexp) - (setq icol (+ icol octave-block-offset))) - ((octave-looking-at-kw octave-block-else-regexp) - (if (= bot (point)) - (setq icol (+ icol octave-block-offset)))) - ((octave-looking-at-kw octave-block-end-regexp) - (if (and (not (= bot (point))) - ;; special case for `end' keyword, - ;; applied to all keywords - (not (octave-end-as-array-index-p))) - (setq icol (- icol - (octave-block-end-offset))))))) - (forward-char))) - (if is-continuation-line - (setq icol (+ icol octave-continuation-offset))))))) - (save-excursion - (back-to-indentation) - (cond - ((and (octave-looking-at-kw octave-block-else-regexp) - (octave-not-in-string-or-comment-p)) - (setq icol (- icol octave-block-offset))) - ((and (octave-looking-at-kw octave-block-end-regexp) - (octave-not-in-string-or-comment-p)) - (setq icol (- icol (octave-block-end-offset)))) - ((or (looking-at "\\s<\\s<\\s<\\S<") - (octave-before-magic-comment-p)) - (setq icol (list 0 icol))) - ((looking-at "\\s<\\S<") - (setq icol (list comment-column icol))))) - icol)) - -;; FIXME: this should probably also make sure we are actually looking -;; at the "end" keyword. -(defun octave-end-as-array-index-p () - (save-excursion - (condition-case nil - ;; Check if point is between parens - (progn (up-list 1) t) - (error nil)))) - -(defun octave-block-end-offset () - (save-excursion - (octave-backward-up-block 1) - (* octave-block-offset - (if (string-match (match-string 0) "switch") 2 1)))) - -(defun octave-before-magic-comment-p () - (save-excursion - (beginning-of-line) - (and (bobp) (looking-at "\\s-*#!")))) - -(defun octave-indent-line (&optional arg) - "Indent current line as Octave code. -With optional ARG, use this as offset unless this line is a comment with -fixed goal column." - (interactive) - (or arg (setq arg 0)) - (let ((icol (octave-indent-calculate)) - (relpos (- (current-column) (current-indentation)))) - (if (listp icol) - (setq icol (car icol)) - (setq icol (+ icol arg))) - (if (< icol 0) - (error "Unmatched end keyword") - (indent-line-to icol) - (if (> relpos 0) - (move-to-column (+ icol relpos)))))) (defun octave-indent-new-comment-line () "Break Octave line at point, continuing comment if within one. @@ -967,106 +834,17 @@ (zerop (forward-line 1))))) (end-of-line))) -(defun octave-scan-blocks (count depth) - "Scan from point by COUNT Octave begin-end blocks. -Returns the character number of the position thus found. - -If DEPTH is nonzero, block depth begins counting from that value. -Only places where the depth in blocks becomes zero are candidates for -stopping; COUNT such places are counted. - -If the beginning or end of the buffer is reached and the depth is wrong, -an error is signaled." - (let ((min-depth (if (> depth 0) 0 depth)) - (inc (if (> count 0) 1 -1))) - (save-excursion - (while (/= count 0) - (catch 'foo - (while (or (octave-re-search-forward-kw - octave-block-begin-or-end-regexp inc) - (if (/= depth 0) - (error "Unbalanced block"))) - (if (octave-not-in-string-or-comment-p) - (progn - (cond - ((match-end 1) - (setq depth (+ depth inc))) - ((match-end 2) - (setq depth (- depth inc)))) - (if (< depth min-depth) - (error "Containing expression ends prematurely")) - (if (= depth 0) - (throw 'foo nil)))))) - (setq count (- count inc))) - (point)))) - -(defun octave-forward-block (&optional arg) - "Move forward across one balanced Octave begin-end block. -With argument, do it that many times. -Negative arg -N means move backward across N blocks." - (interactive "p") - (or arg (setq arg 1)) - (goto-char (or (octave-scan-blocks arg 0) (buffer-end arg)))) - -(defun octave-backward-block (&optional arg) - "Move backward across one balanced Octave begin-end block. -With argument, do it that many times. -Negative arg -N means move forward across N blocks." - (interactive "p") - (or arg (setq arg 1)) - (octave-forward-block (- arg))) - -(defun octave-down-block (arg) - "Move forward down one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move backward but still go down a level. -In Lisp programs, an argument is required." - (interactive "p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (octave-scan-blocks inc -1) - (buffer-end arg))) - (setq arg (- arg inc))))) - -(defun octave-backward-up-block (arg) - "Move backward out of one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move forward but still to a less deep spot. -In Lisp programs, an argument is required." - (interactive "p") - (octave-up-block (- arg))) - -(defun octave-up-block (arg) - "Move forward out of one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move backward but still to a less deep spot. -In Lisp programs, an argument is required." - (interactive "p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (octave-scan-blocks inc 1) - (buffer-end arg))) - (setq arg (- arg inc))))) - (defun octave-mark-block () "Put point at the beginning of this Octave block, mark at the end. The block marked is the one that contains point or follows point." (interactive) - (let ((pos (point))) - (if (or (and (octave-in-block-p) - (skip-syntax-forward "w")) - (condition-case nil - (progn - (octave-down-block 1) - (octave-in-block-p)) - (error nil))) - (progn - (octave-up-block -1) - (push-mark (point)) - (octave-forward-block) - (exchange-point-and-mark)) - (goto-char pos) - (message "No block to mark found")))) + (unless (or (looking-at "\\s(") + (save-excursion + (let* ((token (funcall smie-forward-token-function)) + (level (assoc token smie-op-levels))) + (and level (null (cadr level)))))) + (backward-up-list 1)) + (mark-sexp)) (defun octave-blink-matching-block-open () "Blink the matching Octave begin block keyword. @@ -1086,12 +864,12 @@ (setq eb-keyword (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - (octave-backward-up-block 1)) + (backward-up-list 1)) ((match-end 2) (setq eb-keyword (buffer-substring-no-properties (match-beginning 2) (match-end 2))) - (octave-backward-block))) + (backward-sexp 1))) (setq pos (match-end 0) bb-keyword (buffer-substring-no-properties @@ -1202,81 +980,73 @@ (not give-up)))) (defun octave-fill-paragraph (&optional arg) - "Fill paragraph of Octave code, handling Octave comments." - ;; FIXME: now that the default fill-paragraph takes care of similar issues, - ;; this seems obsolete. --Stef - (interactive "P") - (save-excursion - (let ((end (progn (forward-paragraph) (point))) - (beg (progn - (forward-paragraph -1) - (skip-chars-forward " \t\n") - (beginning-of-line) - (point))) - (cfc (current-fill-column)) - (ind (octave-indent-calculate)) - comment-prefix) - (save-restriction - (goto-char beg) - (narrow-to-region beg end) - (if (listp ind) (setq ind (nth 1 ind))) - (while (not (eobp)) - (condition-case nil - (octave-indent-line ind) - (error nil)) - (if (and (> ind 0) - (not - (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\($\\|\\s<+\\)")))) - (setq ind 0)) - (move-to-column cfc) - ;; First check whether we need to combine non-empty comment lines - (if (and (< (current-column) cfc) - (octave-in-comment-p) - (not (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\s<+\\s-*$")))) - ;; This is a nonempty comment line which does not extend - ;; past the fill column. If it is followed by a nonempty - ;; comment line with the same comment prefix, try to - ;; combine them, and repeat this until either we reach the - ;; fill-column or there is nothing more to combine. - (progn - ;; Get the comment prefix - (save-excursion - (beginning-of-line) - (while (and (re-search-forward "\\s<+") - (not (octave-in-comment-p)))) - (setq comment-prefix (match-string 0))) - ;; And keep combining ... - (while (and (< (current-column) cfc) - (save-excursion - (forward-line 1) - (and (looking-at - (concat "^\\s-*" - comment-prefix - "\\S<")) - (not (looking-at - (concat "^\\s-*" - comment-prefix - "\\s-*$")))))) - (delete-char 1) - (re-search-forward comment-prefix) - (delete-region (match-beginning 0) (match-end 0)) - (fixup-whitespace) - (move-to-column cfc)))) - ;; We might also try to combine continued code lines> Perhaps - ;; some other time ... - (skip-chars-forward "^ \t\n") - (delete-horizontal-space) - (if (or (< (current-column) cfc) - (and (= (current-column) cfc) (eolp))) - (forward-line 1) - (if (not (eolp)) (insert " ")) - (or (octave-auto-fill) - (forward-line 1))))) - t))) + "Fill paragraph of Octave code, handling Octave comments." + ;; FIXME: difference with generic fill-paragraph: + ;; - code lines are only split, never joined. + ;; - \n that end comments are never removed. + ;; - insert continuation marker when splitting code lines. + (interactive "P") + (save-excursion + (let ((end (progn (forward-paragraph) (copy-marker (point) t))) + (beg (progn + (forward-paragraph -1) + (skip-chars-forward " \t\n") + (beginning-of-line) + (point))) + (cfc (current-fill-column)) + comment-prefix) + (goto-char beg) + (while (< (point) end) + (condition-case nil + (indent-according-to-mode) + (error nil)) + (move-to-column cfc) + ;; First check whether we need to combine non-empty comment lines + (if (and (< (current-column) cfc) + (octave-in-comment-p) + (not (save-excursion + (beginning-of-line) + (looking-at "^\\s-*\\s<+\\s-*$")))) + ;; This is a nonempty comment line which does not extend + ;; past the fill column. If it is followed by a nonempty + ;; comment line with the same comment prefix, try to + ;; combine them, and repeat this until either we reach the + ;; fill-column or there is nothing more to combine. + (progn + ;; Get the comment prefix + (save-excursion + (beginning-of-line) + (while (and (re-search-forward "\\s<+") + (not (octave-in-comment-p)))) + (setq comment-prefix (match-string 0))) + ;; And keep combining ... + (while (and (< (current-column) cfc) + (save-excursion + (forward-line 1) + (and (looking-at + (concat "^\\s-*" + comment-prefix + "\\S<")) + (not (looking-at + (concat "^\\s-*" + comment-prefix + "\\s-*$")))))) + (delete-char 1) + (re-search-forward comment-prefix) + (delete-region (match-beginning 0) (match-end 0)) + (fixup-whitespace) + (move-to-column cfc)))) + ;; We might also try to combine continued code lines> Perhaps + ;; some other time ... + (skip-chars-forward "^ \t\n") + (delete-horizontal-space) + (if (or (< (current-column) cfc) + (and (= (current-column) cfc) (eolp))) + (forward-line 1) + (if (not (eolp)) (insert " ")) + (or (octave-auto-fill) + (forward-line 1)))) + t))) ;;; Completions
--- a/lisp/textmodes/nroff-mode.el Tue Aug 31 06:57:49 2010 +0000 +++ b/lisp/textmodes/nroff-mode.el Tue Aug 31 22:44:36 2010 +0000 @@ -55,6 +55,7 @@ (define-key map "\n" 'nroff-electric-newline) (define-key map "\en" 'nroff-forward-text-line) (define-key map "\ep" 'nroff-backward-text-line) + (define-key map "\C-c\C-c" 'nroff-view) (define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map)) (define-key menu-map [nn] '(menu-item "Newline" nroff-electric-newline @@ -73,6 +74,9 @@ nroff-electric-mode :help "Auto insert closing requests if necessary" :button (:toggle . nroff-electric-mode))) + (define-key menu-map [npm] + '(menu-item "Preview as man page" nroff-view + :help "Run man on this file.")) map) "Major mode keymap for `nroff-mode'.") @@ -301,6 +305,17 @@ :lighter " Electric" (or (derived-mode-p 'nroff-mode) (error "Must be in nroff mode"))) +(declare-function Man-getpage-in-background "man" (topic)) + +(defun nroff-view () + "Run man on this file." + (interactive) + (require 'man) + (let* ((file (buffer-file-name))) + (if file + (Man-getpage-in-background file) + (error "No associated file for the current buffer")))) + ;; Old names that were not namespace clean. (define-obsolete-function-alias 'count-text-lines 'nroff-count-text-lines "22.1") (define-obsolete-function-alias 'forward-text-line 'nroff-forward-text-line "22.1")
--- a/src/ChangeLog Tue Aug 31 06:57:49 2010 +0000 +++ b/src/ChangeLog Tue Aug 31 22:44:36 2010 +0000 @@ -1,3 +1,11 @@ +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * keyboard.c (Fwindow_system): Fix compilation for USE_LISP_UNION_TYPE. + +2010-08-31 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (command_loop_1): Don't call x-set-selection on tty. + 2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> * marker.c (Fcopy_marker): Make the first arg optional.
--- a/src/keyboard.c Tue Aug 31 06:57:49 2010 +0000 +++ b/src/keyboard.c Tue Aug 31 22:44:36 2010 +0000 @@ -1493,6 +1493,11 @@ } #endif +/* FIXME: This is wrong rather than test window-system, we should call + a new set-selection, which will then dispatch to x-set-selection, or + tty-set-selection, or w32-set-selection, ... */ +EXFUN (Fwindow_system, 1); + Lisp_Object command_loop_1 (void) { @@ -1799,10 +1804,11 @@ { /* Even if not deactivating the mark, set PRIMARY if `select-active-regions' is non-nil. */ - if ((EQ (Vselect_active_regions, Qonly) - ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) - : (!NILP (Vselect_active_regions) - && !NILP (Vtransient_mark_mode))) + if (!NILP (Fwindow_system (Qnil)) + && (EQ (Vselect_active_regions, Qonly) + ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) + : (!NILP (Vselect_active_regions) + && !NILP (Vtransient_mark_mode))) && !EQ (Vthis_command, Qhandle_switch_frame)) { int beg = XINT (Fmarker_position (current_buffer->mark));