diff options
Diffstat (limited to 'lisp/textmodes')
31 files changed, 4100 insertions, 3822 deletions
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 06610d3434b..74d214496e2 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -35,7 +35,7 @@ "Major mode for editing bib files." :prefix "bib-" :group 'external - :group 'wp) + :group 'text) (defcustom bib-file "~/my-bibliography.bib" "Default name of file used by `addbib'." diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 6cbdc1efd85..2128e50797d 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -317,6 +317,20 @@ If parsing fails, try to set this variable to nil." ("organization" "Sponsoring organization of the conference") ("publisher" "Publishing company, its location") ("note"))) + ("Conference" "Article in Conference Proceedings" ; same as InProceedings + (("author") + ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")) + (("booktitle" "Name of the conference proceedings") + ("year")) + (("editor") + ("volume" "Volume of the conference proceedings in the series") + ("number" "Number of the conference proceedings in a small series (overwritten by volume)") + ("series" "Series in which the conference proceedings appeared") + ("pages" "Pages in the conference proceedings") + ("month") ("address") + ("organization" "Sponsoring organization of the conference") + ("publisher" "Publishing company, its location") + ("note"))) ("InCollection" "Article in a Collection" (("author") ("title" "Title of the article in book (BibTeX converts it to lowercase)") @@ -444,7 +458,7 @@ which is called to determine the initial content of the field. ALTERNATIVE if non-nil is an integer that numbers sets of alternatives, starting from zero." :group 'BibTeX - :version "24.1" + :version "26.1" ; add Conference :type 'bibtex-entry-alist) (put 'bibtex-BibTeX-entry-alist 'risky-local-variable t) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 0ae187b8d3c..91ebbf6f940 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -27,13 +27,17 @@ ;;; Todo: -;; - electric ; and } ;; - filling code with auto-fill-mode -;; - attribute value completion ;; - fix font-lock errors with multi-line selectors ;;; Code: +(require 'eww) +(require 'seq) +(require 'sgml-mode) +(require 'smie) +(eval-when-compile (require 'subr-x)) + (defgroup css nil "Cascading Style Sheets (CSS) editing mode." :group 'languages) @@ -51,9 +55,20 @@ "Identifiers for pseudo-elements.") (defconst css-at-ids - '("charset" "font-face" "import" "media" "namespace" "page") + '("charset" "font-face" "import" "keyframes" "media" "namespace" + "page" "supports") "Identifiers that appear in the form @foo.") +(defconst scss-at-ids + '("at-root" "content" "debug" "each" "else" "else if" "error" "extend" + "for" "function" "if" "import" "include" "mixin" "return" "warn" + "while") + "Additional identifiers that appear in the form @foo in SCSS.") + +(defvar css--at-ids css-at-ids + "List of at-rules for the current mode.") +(make-variable-buffer-local 'css--at-ids) + (defconst css-bang-ids '("important") "Identifiers that appear in the form !foo.") @@ -62,6 +77,10 @@ '("default" "global" "optional") "Additional identifiers that appear in the form !foo in SCSS.") +(defvar css--bang-ids css-bang-ids + "List of bang-rules for the current mode.") +(make-variable-buffer-local 'css--bang-ids) + (defconst css-descriptor-ids '("ascent" "baseline" "bbox" "cap-height" "centerline" "definition-src" "descent" "font-family" "font-size" "font-stretch" "font-style" @@ -74,110 +93,508 @@ "visual") "Identifiers for types of media.") -(defconst css-property-ids - '(;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html). - ;; - ;; Properties duplicated by any of the CSS3 modules below have - ;; been removed. - "azimuth" "border-collapse" "border-spacing" "bottom" - "caption-side" "clear" "clip" "content" "counter-increment" - "counter-reset" "cue" "cue-after" "cue-before" "direction" "display" - "elevation" "empty-cells" "float" "height" "left" "line-height" - "list-style" "list-style-image" "list-style-position" - "list-style-type" "margin" "margin-bottom" "margin-left" - "margin-right" "margin-top" "max-height" "max-width" "min-height" - "min-width" "orphans" "padding" "padding-bottom" "padding-left" - "padding-right" "padding-top" "page-break-after" - "page-break-before" "page-break-inside" "pause" "pause-after" - "pause-before" "pitch" "pitch-range" "play-during" "position" - "quotes" "richness" "right" "speak" "speak-header" "speak-numeral" - "speak-punctuation" "speech-rate" "stress" "table-layout" "top" - "unicode-bidi" "vertical-align" "visibility" "voice-family" "volume" - "widows" "width" "z-index" +(defconst css-property-alist + ;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html). + ;; + ;; Properties duplicated by any of the CSS3 modules below have been + ;; removed. + '(("azimuth" angle "left-side" "far-left" "left" "center-left" + "center" "center-right" "right" "far-right" "right-side" "behind" + "leftwards" "rightwards") + ("border-collapse" "collapse" "separate") + ("border-spacing" length) + ("bottom" length percentage "auto") + ("caption-side" "top" "bottom") + ("clear" "none" "left" "right" "both") + ("clip" shape "auto") + ("content" "normal" "none" string uri counter "attr()" + "open-quote" "close-quote" "no-open-quote" "no-close-quote") + ("counter-increment" identifier integer "none") + ("counter-reset" identifier integer "none") + ("cue" cue-before cue-after) + ("cue-after" uri "none") + ("cue-before" uri "none") + ("direction" "ltr" "rtl") + ("display" "inline" "block" "list-item" "inline-block" "table" + "inline-table" "table-row-group" "table-header-group" + "table-footer-group" "table-row" "table-column-group" + "table-column" "table-cell" "table-caption" "none" + ;; CSS Flexible Box Layout Module Level 1 + ;; (https://www.w3.org/TR/css3-flexbox/#valdef-display-flex) + "flex" "inline-flex") + ("elevation" angle "below" "level" "above" "higher" "lower") + ("empty-cells" "show" "hide") + ("float" "left" "right" "none") + ("height" length percentage "auto") + ("left" length percentage "auto") + ("line-height" "normal" number length percentage) + ("list-style" list-style-type list-style-position + list-style-image) + ("list-style-image" uri "none") + ("list-style-position" "inside" "outside") + ("list-style-type" "disc" "circle" "square" "decimal" + "decimal-leading-zero" "lower-roman" "upper-roman" "lower-greek" + "lower-latin" "upper-latin" "armenian" "georgian" "lower-alpha" + "upper-alpha" "none") + ("margin" margin-width) + ("margin-bottom" margin-width) + ("margin-left" margin-width) + ("margin-right" margin-width) + ("margin-top" margin-width) + ("max-height" length percentage "none") + ("max-width" length percentage "none") + ("min-height" length percentage) + ("min-width" length percentage) + ("padding" padding-width) + ("padding-bottom" padding-width) + ("padding-left" padding-width) + ("padding-right" padding-width) + ("padding-top" padding-width) + ("page-break-after" "auto" "always" "avoid" "left" "right") + ("page-break-before" "auto" "always" "avoid" "left" "right") + ("page-break-inside" "avoid" "auto") + ("pause" time percentage) + ("pause-after" time percentage) + ("pause-before" time percentage) + ("pitch" frequency "x-low" "low" "medium" "high" "x-high") + ("pitch-range" number) + ("play-during" uri "mix" "repeat" "auto" "none") + ("position" "static" "relative" "absolute" "fixed") + ("quotes" string "none") + ("richness" number) + ("right" length percentage "auto") + ("speak" "normal" "none" "spell-out") + ("speak-header" "once" "always") + ("speak-numeral" "digits" "continuous") + ("speak-punctuation" "code" "none") + ("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" + "faster" "slower") + ("stress" number) + ("table-layout" "auto" "fixed") + ("top" length percentage "auto") + ("unicode-bidi" "normal" "embed" "bidi-override") + ("vertical-align" "baseline" "sub" "super" "top" "text-top" + "middle" "bottom" "text-bottom" percentage length) + ("visibility" "visible" "hidden" "collapse") + ("voice-family" specific-voice generic-voice specific-voice + generic-voice) + ("volume" number percentage "silent" "x-soft" "soft" "medium" + "loud" "x-loud") + ("width" length percentage "auto") + ("z-index" "auto" integer) ;; CSS Animations ;; (http://www.w3.org/TR/css3-animations/#property-index) - "animation" "animation-delay" "animation-direction" - "animation-duration" "animation-fill-mode" - "animation-iteration-count" "animation-name" - "animation-play-state" "animation-timing-function" + ("animation" single-animation-name time single-timing-function + single-animation-iteration-count single-animation-direction + single-animation-fill-mode single-animation-play-state) + ("animation-delay" time) + ("animation-direction" single-animation-direction) + ("animation-duration" time) + ("animation-fill-mode" single-animation-fill-mode) + ("animation-iteration-count" single-animation-iteration-count) + ("animation-name" single-animation-name) + ("animation-play-state" single-animation-play-state) + ("animation-timing-function" single-timing-function) ;; CSS Backgrounds and Borders Module Level 3 ;; (http://www.w3.org/TR/css3-background/#property-index) - "background" "background-attachment" "background-clip" - "background-color" "background-image" "background-origin" - "background-position" "background-repeat" "background-size" - "border" "border-bottom" "border-bottom-color" - "border-bottom-left-radius" "border-bottom-right-radius" - "border-bottom-style" "border-bottom-width" "border-color" - "border-image" "border-image-outset" "border-image-repeat" - "border-image-slice" "border-image-source" "border-image-width" - "border-left" "border-left-color" "border-left-style" - "border-left-width" "border-radius" "border-right" - "border-right-color" "border-right-style" "border-right-width" - "border-style" "border-top" "border-top-color" - "border-top-left-radius" "border-top-right-radius" - "border-top-style" "border-top-width" "border-width" "box-shadow" + ("background" bg-layer final-bg-layer) + ("background-attachment" attachment) + ("background-clip" box) + ("background-color" color) + ("background-image" bg-image) + ("background-origin" box) + ("background-position" position) + ("background-repeat" repeat-style) + ("background-size" bg-size) + ("border" line-width line-style color) + ("border-bottom" line-width line-style color) + ("border-bottom-color" color) + ("border-bottom-left-radius" length percentage) + ("border-bottom-right-radius" length percentage) + ("border-bottom-style" line-style) + ("border-bottom-width" line-width) + ("border-color" color) + ("border-image" border-image-source border-image-slice + border-image-width border-image-outset border-image-repeat) + ("border-image-outset" length number) + ("border-image-repeat" "stretch" "repeat" "round" "space") + ("border-image-slice" number percentage "fill") + ("border-image-source" "none" image) + ("border-image-width" length percentage number "auto") + ("border-left" line-width line-style color) + ("border-left-color" color) + ("border-left-style" line-style) + ("border-left-width" line-width) + ("border-radius" length percentage) + ("border-right" line-width line-style color) + ("border-right-color" color) + ("border-right-style" line-style) + ("border-right-width" line-width) + ("border-style" line-style) + ("border-top" line-width line-style color) + ("border-top-color" color) + ("border-top-left-radius" length percentage) + ("border-top-right-radius" length percentage) + ("border-top-style" line-style) + ("border-top-width" line-width) + ("border-width" line-width) + ("box-shadow" "none" shadow) ;; CSS Basic User Interface Module Level 3 (CSS3 UI) ;; (http://www.w3.org/TR/css3-ui/#property-index) - "box-sizing" "caret-color" "cursor" "nav-down" "nav-left" - "nav-right" "nav-up" "outline" "outline-color" "outline-offset" - "outline-style" "outline-width" "resize" "text-overflow" + ("box-sizing" "content-box" "border-box") + ("caret-color" "auto" color) + ("cursor" uri x y "auto" "default" "none" "context-menu" "help" + "pointer" "progress" "wait" "cell" "crosshair" "text" + "vertical-text" "alias" "copy" "move" "no-drop" "not-allowed" + "grab" "grabbing" "e-resize" "n-resize" "ne-resize" "nw-resize" + "s-resize" "se-resize" "sw-resize" "w-resize" "ew-resize" + "ns-resize" "nesw-resize" "nwse-resize" "col-resize" "row-resize" + "all-scroll" "zoom-in" "zoom-out") + ("nav-down" "auto" id "current" "root" target-name) + ("nav-left" "auto" id "current" "root" target-name) + ("nav-right" "auto" id "current" "root" target-name) + ("nav-up" "auto" id "current" "root" target-name) + ("outline" outline-color outline-style outline-width) + ("outline-color" color "invert") + ("outline-offset" length) + ("outline-style" "auto" border-style) + ("outline-width" border-width) + ("resize" "none" "both" "horizontal" "vertical") + ("text-overflow" "clip" "ellipsis" string) ;; CSS Color Module Level 3 ;; (http://www.w3.org/TR/css3-color/#property) - "color" "opacity" + ("color" color) + ("opacity" alphavalue) ;; CSS Flexible Box Layout Module Level 1 ;; (http://www.w3.org/TR/css-flexbox-1/#property-index) - "align-content" "align-items" "align-self" "flex" "flex-basis" - "flex-direction" "flex-flow" "flex-grow" "flex-shrink" "flex-wrap" - "justify-content" "order" + ("align-content" "flex-start" "flex-end" "center" "space-between" + "space-around" "stretch") + ("align-items" "flex-start" "flex-end" "center" "baseline" + "stretch") + ("align-self" "auto" "flex-start" "flex-end" "center" "baseline" + "stretch") + ("flex" "none" flex-grow flex-shrink flex-basis) + ("flex-basis" "auto" "content" width) + ("flex-direction" "row" "row-reverse" "column" "column-reverse") + ("flex-flow" flex-direction flex-wrap) + ("flex-grow" number) + ("flex-shrink" number) + ("flex-wrap" "nowrap" "wrap" "wrap-reverse") + ("justify-content" "flex-start" "flex-end" "center" + "space-between" "space-around") + ("order" integer) ;; CSS Fonts Module Level 3 ;; (http://www.w3.org/TR/css3-fonts/#property-index) - "font" "font-family" "font-feature-settings" "font-kerning" - "font-language-override" "font-size" "font-size-adjust" - "font-stretch" "font-style" "font-synthesis" "font-variant" - "font-variant-alternates" "font-variant-caps" - "font-variant-east-asian" "font-variant-ligatures" - "font-variant-numeric" "font-variant-position" "font-weight" + ("font" font-style font-variant-css21 font-weight font-stretch + font-size line-height font-family "caption" "icon" "menu" + "message-box" "small-caption" "status-bar") + ("font-family" family-name generic-family) + ("font-feature-settings" "normal" feature-tag-value) + ("font-kerning" "auto" "normal" "none") + ("font-language-override" "normal" string) + ("font-size" absolute-size relative-size length percentage) + ("font-size-adjust" "none" number) + ("font-stretch" "normal" "ultra-condensed" "extra-condensed" + "condensed" "semi-condensed" "semi-expanded" "expanded" + "extra-expanded" "ultra-expanded") + ("font-style" "normal" "italic" "oblique") + ("font-synthesis" "none" "weight" "style") + ("font-variant" "normal" "none" common-lig-values + discretionary-lig-values historical-lig-values + contextual-alt-values "stylistic()" "historical-forms" + "styleset()" "character-variant()" "swash()" "ornaments()" + "annotation()" "small-caps" "all-small-caps" "petite-caps" + "all-petite-caps" "unicase" "titling-caps" numeric-figure-values + numeric-spacing-values numeric-fraction-values "ordinal" + "slashed-zero" east-asian-variant-values east-asian-width-values + "ruby") + ("font-variant-alternates" "normal" "stylistic()" + "historical-forms" "styleset()" "character-variant()" "swash()" + "ornaments()" "annotation()") + ("font-variant-caps" "normal" "small-caps" "all-small-caps" + "petite-caps" "all-petite-caps" "unicase" "titling-caps") + ("font-variant-east-asian" "normal" east-asian-variant-values + east-asian-width-values "ruby") + ("font-variant-ligatures" "normal" "none" common-lig-values + discretionary-lig-values historical-lig-values + contextual-alt-values) + ("font-variant-numeric" "normal" numeric-figure-values + numeric-spacing-values numeric-fraction-values "ordinal" + "slashed-zero") + ("font-variant-position" "normal" "sub" "super") + ("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" + "300" "400" "500" "600" "700" "800" "900") + + ;; CSS Fragmentation Module Level 3 + ;; (https://www.w3.org/TR/css-break-3/#property-index) + ("box-decoration-break" "slice" "clone") + ("break-after" "auto" "avoid" "avoid-page" "page" "left" "right" + "recto" "verso" "avoid-column" "column" "avoid-region" "region") + ("break-before" "auto" "avoid" "avoid-page" "page" "left" "right" + "recto" "verso" "avoid-column" "column" "avoid-region" "region") + ("break-inside" "auto" "avoid" "avoid-page" "avoid-column" + "avoid-region") + ("orphans" integer) + ("widows" integer) + + ;; CSS Multi-column Layout Module + ;; (https://www.w3.org/TR/css3-multicol/#property-index) + ;; "break-after", "break-before", and "break-inside" are left out + ;; below, because they're already included in CSS Fragmentation + ;; Module Level 3. + ("column-count" integer "auto") + ("column-fill" "auto" "balance") + ("column-gap" length "normal") + ("column-rule" column-rule-width column-rule-style + column-rule-color "transparent") + ("column-rule-color" color) + ("column-rule-style" border-style) + ("column-rule-width" border-width) + ("column-span" "none" "all") + ("column-width" length "auto") + ("columns" column-width column-count) ;; CSS Overflow Module Level 3 ;; (http://www.w3.org/TR/css-overflow-3/#property-index) - "max-lines" "overflow" "overflow-x" "overflow-y" + ("max-lines" "none" integer) + ("overflow" "visible" "hidden" "scroll" "auto" "paged-x" "paged-y" + "paged-x-controls" "paged-y-controls" "fragments") + ("overflow-x" "visible" "hidden" "scroll" "auto" "paged-x" + "paged-y" "paged-x-controls" "paged-y-controls" "fragments") + ("overflow-y" "visible" "hidden" "scroll" "auto" "paged-x" + "paged-y" "paged-x-controls" "paged-y-controls" "fragments") ;; CSS Text Decoration Module Level 3 ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index) - "text-decoration" "text-decoration-color" "text-decoration-line" - "text-decoration-skip" "text-decoration-style" "text-emphasis" - "text-emphasis-color" "text-emphasis-position" "text-emphasis-style" - "text-shadow" "text-underline-position" + ("text-decoration" text-decoration-line text-decoration-style + text-decoration-color) + ("text-decoration-color" color) + ("text-decoration-line" "none" "underline" "overline" + "line-through" "blink") + ("text-decoration-skip" "none" "objects" "spaces" "ink" "edges" + "box-decoration") + ("text-decoration-style" "solid" "double" "dotted" "dashed" + "wavy") + ("text-emphasis" text-emphasis-style text-emphasis-color) + ("text-emphasis-color" color) + ("text-emphasis-position" "over" "under" "right" "left") + ("text-emphasis-style" "none" "filled" "open" "dot" "circle" + "double-circle" "triangle" "sesame" string) + ("text-shadow" "none" length color) + ("text-underline-position" "auto" "under" "left" "right") ;; CSS Text Module Level 3 ;; (http://www.w3.org/TR/css3-text/#property-index) - "hanging-punctuation" "hyphens" "letter-spacing" "line-break" - "overflow-wrap" "tab-size" "text-align" "text-align-last" - "text-indent" "text-justify" "text-transform" "white-space" - "word-break" "word-spacing" "word-wrap" + ("hanging-punctuation" "none" "first" "force-end" "allow-end" + "last") + ("hyphens" "none" "manual" "auto") + ("letter-spacing" "normal" length) + ("line-break" "auto" "loose" "normal" "strict") + ("overflow-wrap" "normal" "break-word") + ("tab-size" integer length) + ("text-align" "start" "end" "left" "right" "center" "justify" + "match-parent") + ("text-align-last" "auto" "start" "end" "left" "right" "center" + "justify") + ("text-indent" length percentage) + ("text-justify" "auto" "none" "inter-word" "distribute") + ("text-transform" "none" "capitalize" "uppercase" "lowercase" + "full-width") + ("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line") + ("word-break" "normal" "keep-all" "break-all") + ("word-spacing" "normal" length percentage) + ("word-wrap" "normal" "break-word") ;; CSS Transforms Module Level 1 ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index) - "backface-visibility" "perspective" "perspective-origin" - "transform" "transform-origin" "transform-style" + ("backface-visibility" "visible" "hidden") + ("perspective" "none" length) + ("perspective-origin" "left" "center" "right" "top" "bottom" + percentage length) + ("transform" "none" transform-list) + ("transform-origin" "left" "center" "right" "top" "bottom" + percentage length) + ("transform-style" "flat" "preserve-3d") ;; CSS Transitions ;; (http://www.w3.org/TR/css3-transitions/#property-index) - "transition" "transition-delay" "transition-duration" - "transition-property" "transition-timing-function" + ("transition" single-transition) + ("transition-delay" time) + ("transition-duration" time) + ("transition-property" "none" single-transition-property "all") + ("transition-timing-function" single-transition-timing-function) + + ;; CSS Will Change Module Level 1 + ;; (https://www.w3.org/TR/css-will-change-1/#property-index) + ("will-change" "auto" animateable-feature) ;; Filter Effects Module Level 1 ;; (http://www.w3.org/TR/filter-effects/#property-index) - "color-interpolation-filters" "filter" "flood-color" - "flood-opacity" "lighting-color") + ("color-interpolation-filters" "auto" "sRGB" "linearRGB") + ("filter" "none" filter-function-list) + ("flood-color" color) + ("flood-opacity" number percentage) + ("lighting-color" color) + + ;; Pointer Events + ;; (https://www.w3.org/TR/pointerevents/#the-touch-action-css-property) + ("touch-action" "auto" "none" "pan-x" "pan-y" "manipulation")) + "Identifiers for properties and their possible values. +The CAR of each entry is the name of a property, while the CDR is +a list of possible values for that property. String values in +the CDRs represent literal values, while symbols represent one of +the value classes found in `css-value-class-alist'. If a symbol +is not found in `css-value-class-alist', it's interpreted as a +reference back to one of the properties in this list. Some +symbols, such as `number' or `identifier', don't produce any +further value candidates, since that list would be infinite.") + +(defconst css-property-ids + (mapcar #'car css-property-alist) "Identifiers for properties.") +(defconst css-value-class-alist + '((absolute-size + "xx-small" "x-small" "small" "medium" "large" "x-large" + "xx-large") + (alphavalue number) + (angle "calc()") + (animateable-feature "scroll-position" "contents" custom-ident) + (attachment "scroll" "fixed" "local") + (bg-image image "none") + (bg-layer bg-image position repeat-style attachment box) + (bg-size length percentage "auto" "cover" "contain") + (box "border-box" "padding-box" "content-box") + (color + "rgb()" "rgba()" "hsl()" "hsla()" named-color "transparent" + "currentColor") + (common-lig-values "common-ligatures" "no-common-ligatures") + (contextual-alt-values "contextual" "no-contextual") + (counter "counter()" "counters()") + (discretionary-lig-values + "discretionary-ligatures" "no-discretionary-ligatures") + (east-asian-variant-values + "jis78" "jis83" "jis90" "jis04" "simplified" "traditional") + (east-asian-width-values "full-width" "proportional-width") + (family-name "Courier" "Helvetica" "Times") + (feature-tag-value string integer "on" "off") + (filter-function + "blur()" "brightness()" "contrast()" "drop-shadow()" + "grayscale()" "hue-rotate()" "invert()" "opacity()" "sepia()" + "saturate()") + (filter-function-list filter-function uri) + (final-bg-layer + bg-image position repeat-style attachment box color) + (font-variant-css21 "normal" "small-caps") + (frequency "calc()") + (generic-family + "serif" "sans-serif" "cursive" "fantasy" "monospace") + (generic-voice "male" "female" "child") + (gradient + linear-gradient radial-gradient repeating-linear-gradient + repeating-radial-gradient) + (historical-lig-values + "historical-ligatures" "no-historical-ligatures") + (image uri image-list element-reference gradient) + (image-list "image()") + (integer "calc()") + (length "calc()" number) + (line-height "normal" number length percentage) + (line-style + "none" "hidden" "dotted" "dashed" "solid" "double" "groove" + "ridge" "inset" "outset") + (line-width length "thin" "medium" "thick") + (linear-gradient "linear-gradient()") + (margin-width "auto" length percentage) + (named-color + "aliceblue" "antiquewhite" "aqua" "aquamarine" "azure" "beige" + "bisque" "black" "blanchedalmond" "blue" "blueviolet" "brown" + "burlywood" "cadetblue" "chartreuse" "chocolate" "coral" + "cornflowerblue" "cornsilk" "crimson" "cyan" "darkblue" + "darkcyan" "darkgoldenrod" "darkgray" "darkgreen" "darkkhaki" + "darkmagenta" "darkolivegreen" "darkorange" "darkorchid" + "darkred" "darksalmon" "darkseagreen" "darkslateblue" + "darkslategray" "darkturquoise" "darkviolet" "deeppink" + "deepskyblue" "dimgray" "dodgerblue" "firebrick" "floralwhite" + "forestgreen" "fuchsia" "gainsboro" "ghostwhite" "gold" + "goldenrod" "gray" "green" "greenyellow" "honeydew" "hotpink" + "indianred" "indigo" "ivory" "khaki" "lavender" "lavenderblush" + "lawngreen" "lemonchiffon" "lightblue" "lightcoral" "lightcyan" + "lightgoldenrodyellow" "lightgray" "lightgreen" "lightpink" + "lightsalmon" "lightseagreen" "lightskyblue" "lightslategray" + "lightsteelblue" "lightyellow" "lime" "limegreen" "linen" + "magenta" "maroon" "mediumaquamarine" "mediumblue" "mediumorchid" + "mediumpurple" "mediumseagreen" "mediumslateblue" + "mediumspringgreen" "mediumturquoise" "mediumvioletred" + "midnightblue" "mintcream" "mistyrose" "moccasin" "navajowhite" + "navy" "oldlace" "olive" "olivedrab" "orange" "orangered" + "orchid" "palegoldenrod" "palegreen" "paleturquoise" + "palevioletred" "papayawhip" "peachpuff" "peru" "pink" "plum" + "powderblue" "purple" "rebeccapurple" "red" "rosybrown" + "royalblue" "saddlebrown" "salmon" "sandybrown" "seagreen" + "seashell" "sienna" "silver" "skyblue" "slateblue" "slategray" + "snow" "springgreen" "steelblue" "tan" "teal" "thistle" "tomato" + "turquoise" "violet" "wheat" "white" "whitesmoke" "yellow" + "yellowgreen") + (number "calc()") + (numeric-figure-values "lining-nums" "oldstyle-nums") + (numeric-fraction-values "diagonal-fractions" "stacked-fractions") + (numeric-spacing-values "proportional-nums" "tabular-nums") + (padding-width length percentage) + (position + "left" "center" "right" "top" "bottom" percentage length) + (radial-gradient "radial-gradient()") + (relative-size "larger" "smaller") + (repeat-style + "repeat-x" "repeat-y" "repeat" "space" "round" "no-repeat") + (repeating-linear-gradient "repeating-linear-gradient()") + (repeating-radial-gradient "repeating-radial-gradient()") + (shadow "inset" length color) + (shape "rect()") + (single-animation-direction + "normal" "reverse" "alternate" "alternate-reverse") + (single-animation-fill-mode "none" "forwards" "backwards" "both") + (single-animation-iteration-count "infinite" number) + (single-animation-name "none" identifier) + (single-animation-play-state "running" "paused") + (single-timing-function single-transition-timing-function) + (single-transition + "none" single-transition-property time + single-transition-timing-function) + (single-transition-property "all" identifier) + (single-transition-timing-function + "ease" "linear" "ease-in" "ease-out" "ease-in-out" "step-start" + "step-end" "steps()" "cubic-bezier()") + (specific-voice identifier) + (target-name string) + (time "calc()") + (transform-list + "matrix()" "translate()" "translateX()" "translateY()" "scale()" + "scaleX()" "scaleY()" "rotate()" "skew()" "skewX()" "skewY()" + "matrix3d()" "translate3d()" "translateZ()" "scale3d()" + "scaleZ()" "rotate3d()" "rotateX()" "rotateY()" "rotateZ()" + "perspective()") + (uri "url()") + (width length percentage "auto") + (x number) + (y number)) + "Property value classes and their values. +The format is similar to that of `css-property-alist', except +that the CARs aren't actual CSS properties, but rather a name for +a class of values, and that symbols in the CDRs always refer to +other entries in this list, not to properties. + +The following classes have been left out above because they +cannot be completed sensibly: `custom-ident', +`element-reference', `id', `identifier', `percentage', and +`string'.") + (defcustom css-electric-keys '(?\} ?\;) ;; '() "Self inserting keys which should trigger re-indentation." :version "22.2" @@ -210,6 +627,12 @@ (modify-syntax-entry ?- "_" st) st)) +(defvar css-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap info-lookup-symbol] 'css-lookup-symbol) + map) + "Keymap used in `css-mode'.") + (eval-and-compile (defconst css--uri-re (concat @@ -243,9 +666,7 @@ "Face to use for vendor-specific properties.") (defun css--font-lock-keywords (&optional sassy) - `((,(concat "!\\s-*" - (regexp-opt (append (if sassy scss-bang-ids) - css-bang-ids))) + `((,(concat "!\\s-*" (regexp-opt css--bang-ids)) (0 font-lock-builtin-face)) ;; Atrules keywords. IDs not in css-at-ids are valid (ignored). ;; In fact the regexp should probably be @@ -257,6 +678,8 @@ ;; Variables. (,(concat "--" css-ident-re) (0 font-lock-variable-name-face)) ;; Selectors. + ;; Allow plain ":root" as a selector. + ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\)*{" (1 'css-selector keep)) ;; FIXME: attribute selectors don't work well because they may contain ;; strings which have already been highlighted as f-l-string-face and ;; thus prevent this highlighting from being applied (actually now that @@ -277,7 +700,8 @@ ;; Even though pseudo-elements should be prefixed by ::, a ;; single colon is accepted for backward compatibility. "\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids - css-pseudo-element-ids) t) + css-pseudo-element-ids) + t) "\\|\\::" (regexp-opt css-pseudo-element-ids t) "\\)" "\\(?:([^)]+)\\)?" (if (not sassy) @@ -321,11 +745,32 @@ :type 'integer :safe 'integerp) -(require 'smie) - (defconst css-smie-grammar (smie-prec2->grammar - (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) + (smie-precs->prec2 + '((assoc ";") + ;; Colons that belong to a CSS property. These get a higher + ;; precedence than other colons, such as colons in selectors, + ;; which are represented by a plain ":" token. + (left ":-property") + (assoc ",") + (assoc ":"))))) + +(defun css--colon-inside-selector-p () + "Return t if point looks to be inside a CSS selector. +This function is intended to be good enough to help SMIE during +tokenization, but should not be regarded as a reliable function +for determining whether point is within a selector." + (save-excursion + (re-search-forward "[{};)]" nil t) + (eq (char-before) ?\{))) + +(defun css--colon-inside-funcall () + "Return t if point is inside a function call." + (when-let (opening-paren-pos (nth 1 (syntax-ppss))) + (save-excursion + (goto-char opening-paren-pos) + (eq (char-after) ?\()))) (defun css-smie--forward-token () (cond @@ -339,7 +784,13 @@ ";") ((progn (forward-comment (point-max)) (looking-at "[;,:]")) - (forward-char 1) (match-string 0)) + (forward-char 1) + (if (equal (match-string 0) ":") + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (match-string 0))) (t (smie-default-forward-token)))) (defun css-smie--backward-token () @@ -350,7 +801,13 @@ ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) (> pos (point))) ";") ((memq (char-before) '(?\; ?\, ?\:)) - (forward-char -1) (string (char-after))) + (forward-char -1) + (if (eq (char-after) ?\:) + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (string (char-after)))) (t (smie-default-backward-token))))) (defun css-smie-rules (kind token) @@ -377,6 +834,14 @@ (when (memq (char-before) '(?\{ ?\;)) (list start pos css-property-ids)))))) +(defun css--complete-bang-rule () + "Complete bang-rule at point." + (save-excursion + (let ((pos (point))) + (skip-chars-backward "-[:alnum:]") + (when (eq (char-before) ?\!) + (list (point) pos css--bang-ids))))) + (defun css--complete-pseudo-element-or-class () "Complete pseudo-element or pseudo-class at point." (save-excursion @@ -394,15 +859,133 @@ (let ((pos (point))) (skip-chars-backward "-[:alnum:]") (when (eq (char-before) ?\@) - (list (point) pos css-at-ids))))) + (list (point) pos css--at-ids))))) + +(defvar css--property-value-cache + (make-hash-table :test 'equal :size (length css-property-alist)) + "Cache of previously completed property values.") + +(defun css--value-class-lookup (value-class) + "Return a list of value completion candidates for VALUE-CLASS. +Completion candidates are looked up in `css-value-class-alist' by +the symbol VALUE-CLASS." + (seq-uniq + (seq-mapcat + (lambda (value) + (if (stringp value) + (list value) + (css--value-class-lookup value))) + (cdr (assq value-class css-value-class-alist))))) + +(defun css--property-values (property) + "Return a list of value completion candidates for PROPERTY. +Completion candidates are looked up in `css-property-alist' by +the string PROPERTY." + (or (gethash property css--property-value-cache) + (let ((values + (seq-uniq + (seq-mapcat + (lambda (value) + (if (stringp value) + (list value) + (or (css--value-class-lookup value) + (css--property-values (symbol-name value))))) + (cdr (assoc property css-property-alist)))))) + (puthash property values css--property-value-cache)))) + +(defun css--complete-property-value () + "Complete property value at point." + (let ((property + (save-excursion + (re-search-backward ":[^/]" (line-beginning-position) t) + (let ((property-end (point))) + (skip-chars-backward "-[:alnum:]") + (let ((property (buffer-substring (point) property-end))) + (car (member property css-property-ids))))))) + (when property + (let ((end (point))) + (save-excursion + (skip-chars-backward "[:graph:]") + (list (point) end + (append '("inherit" "initial" "unset") + (css--property-values property)))))))) + +(defvar css--html-tags (mapcar #'car html-tag-alist) + "List of HTML tags. +Used to provide completion of HTML tags in selectors.") + +(defvar css--nested-selectors-allowed nil + "Non-nil if nested selectors are allowed in the current mode.") +(make-variable-buffer-local 'css--nested-selectors-allowed) + +(defvar css-class-list-function #'ignore + "Called to provide completions of class names. +This can be bound by buffers that are able to suggest class name +completions, such as HTML mode buffers.") + +(defvar css-id-list-function #'ignore + "Called to provide completions of IDs. +This can be bound by buffers that are able to suggest ID +completions, such as HTML mode buffers.") + +(defun css--foreign-completions (extractor) + "Return a list of completions provided by other buffers. +EXTRACTOR should be the name of a function that may be defined in +one or more buffers. In each of the buffers where EXTRACTOR is +defined, EXTRACTOR is called and the results are accumulated into +a list of completions." + (delete-dups + (seq-mapcat + (lambda (buf) + (with-current-buffer buf + (funcall (symbol-value extractor)))) + (buffer-list)))) + +(defun css--complete-selector () + "Complete part of a CSS selector at point." + (when (or (= (nth 0 (syntax-ppss)) 0) css--nested-selectors-allowed) + (let ((end (point))) + (save-excursion + (skip-chars-backward "-[:alnum:]") + (let ((start-char (char-before))) + (list + (point) end + (completion-table-dynamic + (lambda (_) + (cond + ((eq start-char ?.) + (css--foreign-completions 'css-class-list-function)) + ((eq start-char ?#) + (css--foreign-completions 'css-id-list-function)) + (t css--html-tags)))))))))) (defun css-completion-at-point () "Complete current symbol at point. -Currently supports completion of CSS properties, pseudo-elements, -pseudo-classes, and at-rules." - (or (css--complete-property) +Currently supports completion of CSS properties, property values, +pseudo-elements, pseudo-classes, at-rules, and bang-rules." + (or (css--complete-bang-rule) + (css--complete-property-value) (css--complete-pseudo-element-or-class) - (css--complete-at-rule))) + (css--complete-at-rule) + (seq-let (prop-beg prop-end prop-table) (css--complete-property) + (seq-let (sel-beg sel-end sel-table) (css--complete-selector) + (when (or prop-table sel-table) + ;; FIXME: If both prop-table and sel-table are set but + ;; prop-beg/prop-end is different from sel-beg/sel-end + ;; we have a problem! + `(,@(if prop-table + (list prop-beg prop-end) + (list sel-beg sel-end)) + ,(completion-table-merge prop-table sel-table) + :exit-function + ,(lambda (string status) + (and (eq status 'finished) + prop-table + (test-completion string prop-table) + (not (and sel-table + (test-completion string sel-table))) + (progn (insert ": ;") + (forward-char -1)))))))))) ;;;###autoload (define-derived-mode css-mode prog-mode "CSS" @@ -533,9 +1116,11 @@ pseudo-classes, and at-rules." (let ((st (make-syntax-table css-mode-syntax-table))) (modify-syntax-entry ?/ ". 124" st) (modify-syntax-entry ?\n ">" st) + ;; Variable names are prefixed by $. + (modify-syntax-entry ?$ "'" st) st)) -(defvar scss-font-lock-keywords +(defun scss-font-lock-keywords () (append `((,(concat "$" css-ident-re) (0 font-lock-variable-name-face))) (css--font-lock-keywords 'sassy) `((,(concat "@mixin[ \t]+\\(" css-ident-re "\\)[ \t]*(") @@ -556,7 +1141,120 @@ pseudo-classes, and at-rules." (setq-local comment-continue " *") (setq-local comment-start-skip "/[*/]+[ \t]*") (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)") - (setq-local font-lock-defaults '(scss-font-lock-keywords nil t))) + (setq-local css--at-ids (append css-at-ids scss-at-ids)) + (setq-local css--bang-ids (append css-bang-ids scss-bang-ids)) + (setq-local css--nested-selectors-allowed t) + (setq-local font-lock-defaults + (list (scss-font-lock-keywords) nil t))) + + + +(defvar css--mdn-lookup-history nil) + +(defcustom css-lookup-url-format + "https://developer.mozilla.org/en-US/docs/Web/CSS/%s?raw¯os" + "Format for a URL where CSS documentation can be found. +The format should include a single \"%s\" substitution. +The name of the CSS property, @-id, pseudo-class, or pseudo-element +to look up will be substituted there." + :version "26.1" + :type 'string + :group 'css) + +(defun css--mdn-after-render () + (setf header-line-format nil) + (goto-char (point-min)) + (let ((window (get-buffer-window (current-buffer) 'visible))) + (when window + (when (re-search-forward "^Summary" nil 'move) + (beginning-of-line) + (set-window-start window (point)))))) + +(defconst css--mdn-symbol-regexp + (concat "\\(" + ;; @-ids. + "\\(@" (regexp-opt css-at-ids) "\\)" + "\\|" + ;; ;; Known properties. + (regexp-opt css-property-ids t) + "\\|" + ;; Pseudo-classes. + "\\(:" (regexp-opt css-pseudo-class-ids) "\\)" + "\\|" + ;; Pseudo-elements with either one or two ":"s. + "\\(::?" (regexp-opt css-pseudo-element-ids) "\\)" + "\\)") + "Regular expression to match the CSS symbol at point.") + +(defconst css--mdn-property-regexp + (concat "\\_<" (regexp-opt css-property-ids t) "\\s-*\\(?:\\=\\|:\\)") + "Regular expression to match a CSS property.") + +(defconst css--mdn-completion-list + (nconc + ;; @-ids. + (mapcar (lambda (atrule) (concat "@" atrule)) css-at-ids) + ;; Pseudo-classes. + (mapcar (lambda (class) (concat ":" class)) css-pseudo-class-ids) + ;; Pseudo-elements with either one or two ":"s. + (mapcar (lambda (elt) (concat ":" elt)) css-pseudo-element-ids) + (mapcar (lambda (elt) (concat "::" elt)) css-pseudo-element-ids) + ;; Properties. + css-property-ids) + "List of all symbols available for lookup via MDN.") + +(defun css--mdn-find-symbol () + "A helper for `css-lookup-symbol' that finds the symbol at point. +Returns the symbol, a string, or nil if none found." + (save-excursion + ;; Skip any whitespace between the word and point. + (skip-chars-backward "- \t") + ;; Skip backward over a word. + (skip-chars-backward "-[:alnum:]") + ;; Now skip ":" or "@" to see if it's a pseudo-element or at-id. + (skip-chars-backward "@:") + (if (looking-at css--mdn-symbol-regexp) + (match-string-no-properties 0) + (let ((bound (save-excursion + (beginning-of-line) + (point)))) + (when (re-search-backward css--mdn-property-regexp bound t) + (match-string-no-properties 1)))))) + +;;;###autoload +(defun css-lookup-symbol (symbol) + "Display the CSS documentation for SYMBOL, as found on MDN. +When this command is used interactively, it picks a default +symbol based on the CSS text before point -- either an @-keyword, +a property name, a pseudo-class, or a pseudo-element, depending +on what is seen near point." + (interactive + (list + (let* ((sym (css--mdn-find-symbol)) + (enable-recursive-minibuffers t) + (value (completing-read + (if sym + (format "Describe CSS symbol (default %s): " sym) + "Describe CSS symbol: ") + css--mdn-completion-list nil nil nil + 'css--mdn-lookup-history sym))) + (if (equal value "") sym value)))) + (when symbol + ;; If we see a single-colon pseudo-element like ":after", turn it + ;; into "::after". + (when (and (eq (aref symbol 0) ?:) + (member (substring symbol 1) css-pseudo-element-ids)) + (setq symbol (concat ":" symbol))) + (let ((url (format css-lookup-url-format symbol)) + (buffer (get-buffer-create "*MDN CSS*"))) + (save-selected-window + ;; Make sure to display the buffer before calling `eww', as + ;; that calls `pop-to-buffer-same-window'. + (switch-to-buffer-other-window buffer) + (with-current-buffer buffer + (eww-mode) + (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t) + (eww url)))))) (provide 'css-mode) ;;; css-mode.el ends here diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 8d3e55a9bd7..02cb2a2876d 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -32,6 +32,9 @@ ;; RFC 1034, "DOMAIN NAMES - CONCEPTS AND FACILITIES", P. Mockapetris. ;; RFC 1035, "DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION", P. Mockapetris. +;; RFC 5155, "DNS Security (DNSSEC) Hashed Authenticated Denial of Existence" +;; RFC 6698, "The DNS-Based Authentication of Named Entities (DANE) +;; Transport Layer Security (TLS) Protocol: TLSA" ;;; Release history: @@ -50,13 +53,13 @@ (defconst dns-mode-types '("A" "NS" "MD" "MF" "CNAME" "SOA" "MB" "MG" "MR" "NULL" "WKS" "PTR" "HINFO" "MINFO" "MX" "TXT" - "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP" "NSAP" + "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP" "SIG" "KEY" "PX" "GPOS" "AAAA" "LOC" "NXT" "EID" "NIMLOC" "SRV" "ATMA" "NAPTR" "KX" "CERT" "A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP" "RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID" "UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB" - "MAILA") + "MAILA" "TLSA" "NSEC3") "List of strings with known DNS types.") ;; Font lock. diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index beb6c6dda39..7ace2a50486 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -46,7 +46,7 @@ (defgroup enriched nil "Read and save files in text/enriched format." - :group 'wp) + :group 'text) (defcustom enriched-verbose t "If non-nil, give status messages when reading and writing files." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 459b68f2208..ee523ed5f5c 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -49,6 +49,15 @@ A value of nil means that any change in indentation starts a new paragraph." :group 'fill) (put 'colon-double-space 'safe-local-variable 'booleanp) +(defcustom fill-separate-heterogeneous-words-with-space nil + "Non-nil means that use a space to separate words of different kind. +This will be done with a word in the end of a line and a word in the +beginning of the next line when concatenating them for filling those +lines. Whether to use a space is up to how the words are categorized." + :type 'boolean + :group 'fill + :version "26.1") + (defvar fill-paragraph-function nil "Mode-specific function to fill a paragraph, or nil if there is none. If the function returns nil, then `fill-paragraph' does its normal work. @@ -494,8 +503,11 @@ Point is moved to just past the fill prefix on the first line." (replace-match (get-text-property (match-beginning 0) 'fill-space)) (let ((prev (char-before (match-beginning 0))) (next (following-char))) - (if (and (or (aref (char-category-set next) ?|) - (aref (char-category-set prev) ?|)) + (if (and (if fill-separate-heterogeneous-words-with-space + (and (aref (char-category-set next) ?|) + (aref (char-category-set prev) ?|)) + (or (aref (char-category-set next) ?|) + (aref (char-category-set prev) ?|))) (or (aref fill-nospace-between-words-table next) (aref fill-nospace-between-words-table prev))) (delete-char -1)))))) @@ -804,65 +816,75 @@ region, instead of just filling the current paragraph." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'full) t))) - (or - ;; 1. Fill the region if it is active when called interactively. - (and region transient-mark-mode mark-active - (not (eq (region-beginning) (region-end))) - (or (fill-region (region-beginning) (region-end) justify) t)) - ;; 2. Try fill-paragraph-function. - (and (not (eq fill-paragraph-function t)) - (or fill-paragraph-function - (and (minibufferp (current-buffer)) - (= 1 (point-min)))) - (let ((function (or fill-paragraph-function - ;; In the minibuffer, don't count the width - ;; of the prompt. - 'fill-minibuffer-function)) - ;; If fill-paragraph-function is set, it probably takes care - ;; of comments and stuff. If not, it will have to set - ;; fill-paragraph-handle-comment back to t explicitly or - ;; return nil. - (fill-paragraph-handle-comment nil) - (fill-paragraph-function t)) - (funcall function justify))) - ;; 3. Try our syntax-aware filling code. - (and fill-paragraph-handle-comment - ;; Our code only handles \n-terminated comments right now. - comment-start (equal comment-end "") - (let ((fill-paragraph-handle-comment nil)) - (fill-comment-paragraph justify))) - ;; 4. If it all fails, default to the good ol' text paragraph filling. - (let ((before (point)) - (paragraph-start paragraph-start) - ;; Fill prefix used for filling the paragraph. - fill-pfx) - ;; Try to prevent code sections and comment sections from being - ;; filled together. - (when (and fill-paragraph-handle-comment comment-start-skip) - (setq paragraph-start - (concat paragraph-start "\\|[ \t]*\\(?:" - comment-start-skip "\\)"))) - (save-excursion - ;; To make sure the return value of forward-paragraph is meaningful, - ;; we have to start from the beginning of line, otherwise skipping - ;; past the last few chars of a paragraph-separator would count as - ;; a paragraph (and not skipping any chars at EOB would not count - ;; as a paragraph even if it is). - (move-to-left-margin) - (if (not (zerop (fill-forward-paragraph 1))) - ;; There's no paragraph at or after point: give up. - (setq fill-pfx "") - (let ((end (point)) - (beg (progn (fill-forward-paragraph -1) (point)))) - (goto-char before) - (setq fill-pfx - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this - ;; paragraph may still contain hard newlines. See - ;; fill-region. - (fill-region beg end justify) - (fill-region-as-paragraph beg end justify)))))) - fill-pfx))) + (let ((hash (and (not (buffer-modified-p)) + (buffer-hash)))) + (prog1 + (or + ;; 1. Fill the region if it is active when called interactively. + (and region transient-mark-mode mark-active + (not (eq (region-beginning) (region-end))) + (or (fill-region (region-beginning) (region-end) justify) t)) + ;; 2. Try fill-paragraph-function. + (and (not (eq fill-paragraph-function t)) + (or fill-paragraph-function + (and (minibufferp (current-buffer)) + (= 1 (point-min)))) + (let ((function (or fill-paragraph-function + ;; In the minibuffer, don't count + ;; the width of the prompt. + 'fill-minibuffer-function)) + ;; If fill-paragraph-function is set, it probably + ;; takes care of comments and stuff. If not, it + ;; will have to set fill-paragraph-handle-comment + ;; back to t explicitly or return nil. + (fill-paragraph-handle-comment nil) + (fill-paragraph-function t)) + (funcall function justify))) + ;; 3. Try our syntax-aware filling code. + (and fill-paragraph-handle-comment + ;; Our code only handles \n-terminated comments right now. + comment-start (equal comment-end "") + (let ((fill-paragraph-handle-comment nil)) + (fill-comment-paragraph justify))) + ;; 4. If it all fails, default to the good ol' text paragraph filling. + (let ((before (point)) + (paragraph-start paragraph-start) + ;; Fill prefix used for filling the paragraph. + fill-pfx) + ;; Try to prevent code sections and comment sections from being + ;; filled together. + (when (and fill-paragraph-handle-comment comment-start-skip) + (setq paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)"))) + (save-excursion + ;; To make sure the return value of forward-paragraph is + ;; meaningful, we have to start from the beginning of + ;; line, otherwise skipping past the last few chars of a + ;; paragraph-separator would count as a paragraph (and + ;; not skipping any chars at EOB would not count as a + ;; paragraph even if it is). + (move-to-left-margin) + (if (not (zerop (fill-forward-paragraph 1))) + ;; There's no paragraph at or after point: give up. + (setq fill-pfx "") + (let ((end (point)) + (beg (progn (fill-forward-paragraph -1) (point)))) + (goto-char before) + (setq fill-pfx + (if use-hard-newlines + ;; Can't use fill-region-as-paragraph, since this + ;; paragraph may still contain hard newlines. See + ;; fill-region. + (fill-region beg end justify) + (fill-region-as-paragraph beg end justify)))))) + fill-pfx)) + ;; If we didn't change anything in the buffer (and the buffer + ;; was previously unmodified), then flip the modification status + ;; back to "unchanged". + (when (and hash + (equal hash (buffer-hash))) + (set-buffer-modified-p nil))))) (declare-function comment-search-forward "newcomment" (limit &optional noerror)) (declare-function comment-string-strip "newcomment" (str beforep afterp)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index f7683d96790..0edf9b1a47e 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -88,11 +88,34 @@ downcased before comparing with these exceptions." :version "24.1") (defcustom flyspell-sort-corrections nil - "Non-nil means, sort the corrections alphabetically before popping them." + "If non-nil, sort the corrections before popping them. +The sorting is controlled by the `flyspell-sort-corrections-function' +variable, and defaults to sorting alphabetically." :group 'flyspell :version "21.1" :type 'boolean) +(defcustom flyspell-sort-corrections-function + 'flyspell-sort-corrections-alphabetically + "The function used to sort corrections. +This only happens if `flyspell-sort-corrections' is non-nil. The +function takes three parameters -- the two correction candidates +to be sorted, and the third parameter is the word that's being +corrected." + :version "26.1" + :type 'function + :group 'flyspell) + +(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _) + (string< corr1 corr2)) + +(defun flyspell-sort (corrs word) + (if flyspell-sort-corrections + (sort corrs + (lambda (c1 c2) + (funcall flyspell-sort-corrections-function c1 c2 word))) + corrs)) + (defcustom flyspell-duplicate-distance 400000 "The maximum distance for finding duplicates of unrecognized words. This applies to the feature that when a word is not found in the dictionary, @@ -424,12 +447,7 @@ like <img alt=\"Some thing.\">." ;;* The minor mode declaration. */ ;;*---------------------------------------------------------------------*/ (defvar flyspell-mouse-map - (let ((map (make-sparse-keymap))) - (if (featurep 'xemacs) - (define-key map [button2] #'flyspell-correct-word) - (define-key map [down-mouse-2] #'flyspell-correct-word) - (define-key map [mouse-2] 'undefined)) - map) + (make-sparse-keymap) "Keymap for Flyspell to put on erroneous words.") (defvar flyspell-mode-map @@ -629,9 +647,7 @@ in your init file. ;; the welcome message (if (and flyspell-issue-message-flag flyspell-issue-welcome-flag - (if (featurep 'xemacs) - (interactive-p) ;; XEmacs does not have (called-interactively-p) - (called-interactively-p 'interactive))) + (called-interactively-p 'interactive)) (let ((binding (where-is-internal 'flyspell-auto-correct-word nil 'non-ascii))) (message "%s" @@ -1007,9 +1023,7 @@ Mostly we check word delimiters." (defun flyspell-notify-misspell (word poss) (let ((replacements (if (stringp poss) poss - (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))))) + (flyspell-sort (car (cdr (cdr poss))) word)))) (if flyspell-issue-message-flag (message "misspelling `%s' %S" word replacements)))) @@ -1097,8 +1111,8 @@ misspelling and skips redundant spell-checking step." (flyspell-word (flyspell-get-word following)) start end poss word ispell-filter) (if (or (eq flyspell-word nil) - (and (fboundp flyspell-generic-check-word-predicate) - (not (funcall flyspell-generic-check-word-predicate)))) + (and (functionp flyspell-generic-check-word-predicate) + (not (funcall flyspell-generic-check-word-predicate)))) t (progn ;; destructure return flyspell-word info list. @@ -1158,9 +1172,7 @@ misspelling and skips redundant spell-checking step." (ispell-send-string (concat "^" word "\n")) ;; we mark the ispell process so it can be killed ;; when emacs is exited without query - (if (featurep 'xemacs) - (process-kill-without-query ispell-process) - (set-process-query-on-exit-flag ispell-process nil)) + (set-process-query-on-exit-flag ispell-process nil) ;; Wait until ispell has processed word. (while (progn (accept-process-output ispell-process) @@ -1695,15 +1707,7 @@ FLYSPELL-BUFFER." ;;*---------------------------------------------------------------------*/ (defun flyspell-delete-region-overlays (beg end) "Delete overlays used by flyspell in a given region." - (if (featurep 'emacs) - (remove-overlays beg end 'flyspell-overlay t) - ;; XEmacs does not have `remove-overlays' - (let ((l (overlays-in beg end))) - (while (consp l) - (progn - (if (flyspell-overlay-p (car l)) - (delete-overlay (car l))) - (setq l (cdr l))))))) + (remove-overlays beg end 'flyspell-overlay t)) (defun flyspell-delete-all-overlays () "Delete all the overlays used by flyspell." @@ -1914,7 +1918,7 @@ This command proposes various successive corrections for the current word." ;; invoke the original binding of M-TAB, if that was recorded. (if (and (local-variable-p 'flyspell--prev-meta-tab-binding) (commandp flyspell--prev-meta-tab-binding t) - (fboundp flyspell-generic-check-word-predicate) + (functionp flyspell-generic-check-word-predicate) (not (funcall flyspell-generic-check-word-predicate)) (equal (where-is-internal 'flyspell-auto-correct-word nil t) [?\M-\t])) @@ -1945,7 +1949,7 @@ This command proposes various successive corrections for the current word." (funcall flyspell-insert-function word) (flyspell-word) (flyspell-display-next-corrections flyspell-auto-correct-ring)) - (flyspell-ajust-cursor-point pos (point) old-max) + (flyspell-adjust-cursor-point pos (point) old-max) (setq flyspell-auto-correct-pos (point))) ;; Fetch the word to be checked. (let ((word (flyspell-get-word))) @@ -1979,9 +1983,8 @@ This command proposes various successive corrections for the current word." (error "Ispell: error in Ispell process")) (t ;; The word is incorrect, we have to propose a replacement. - (let ((replacements (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss)))))) + (let ((replacements (flyspell-sort (car (cdr (cdr poss))) + word))) (setq flyspell-auto-correct-region nil) (if (consp replacements) (progn @@ -2013,7 +2016,7 @@ This command proposes various successive corrections for the current word." (flyspell-word) (flyspell-display-next-corrections (cons new-word flyspell-auto-correct-ring)) - (flyspell-ajust-cursor-point pos + (flyspell-adjust-cursor-point pos (point) old-max)))))))))) (setq flyspell-auto-correct-pos (point)) @@ -2136,10 +2139,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ((null poss) ;; ispell error (error "Ispell: error in Ispell process")) - ((featurep 'xemacs) - (flyspell-xemacs-popup - poss word cursor-location start end opoint)) - (t + (t ;; The word is incorrect, we have to propose a replacement. (flyspell-do-correct (flyspell-emacs-popup event poss word) poss word cursor-location start end opoint))) @@ -2150,17 +2150,12 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ;;*---------------------------------------------------------------------*/ (defun flyspell-do-correct (replace poss word cursor-location start end save) "The popup menu callback." - ;; Originally, the XEmacs code didn't do the (goto-char save) here and did - ;; it instead right after calling the function. (cond ((eq replace 'ignore) (goto-char save) nil) ((eq replace 'save) (goto-char save) (ispell-send-string (concat "*" word "\n")) - ;; This was added only to the XEmacs side in revision 1.18 of - ;; flyspell. I assume its absence on the Emacs side was an - ;; oversight. --Stef (ispell-send-string "#\n") (flyspell-unhighlight-at cursor-location) (setq ispell-pdict-modified-p '(t))) @@ -2177,8 +2172,6 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (if (eq replace 'buffer) (ispell-add-per-file-word-list word))) (replace - ;; This was added only to the Emacs side. I assume its absence on - ;; the XEmacs side was an oversight. --Stef (flyspell-unhighlight-at cursor-location) (let ((old-max (point-max)) (new-word (if (atom replace) @@ -2192,17 +2185,15 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (funcall flyspell-insert-function new-word) (if flyspell-abbrev-p (flyspell-define-abbrev word new-word))) - ;; In the original Emacs code, this was only called in the body - ;; of the if. I arbitrarily kept the XEmacs behavior instead. - (flyspell-ajust-cursor-point save cursor-location old-max))) + (flyspell-adjust-cursor-point save cursor-location old-max))) (t (goto-char save) nil))) ;;*---------------------------------------------------------------------*/ -;;* flyspell-ajust-cursor-point ... */ +;;* flyspell-adjust-cursor-point ... */ ;;*---------------------------------------------------------------------*/ -(defun flyspell-ajust-cursor-point (save cursor-location old-max) +(defun flyspell-adjust-cursor-point (save cursor-location old-max) (if (>= save cursor-location) (let ((new-pos (+ save (- (point-max) old-max)))) (goto-char (cond @@ -2229,9 +2220,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (setq event (list (list (car (cdr mouse-pos)) (1+ (cdr (cdr mouse-pos)))) (car mouse-pos))))) - (let* ((corrects (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))) + (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word)) (cor-menu (if (consp corrects) (mapcar (lambda (correct) (list correct correct)) @@ -2258,80 +2247,6 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." menu))))) ;;*---------------------------------------------------------------------*/ -;;* flyspell-xemacs-popup ... */ -;;*---------------------------------------------------------------------*/ -(defun flyspell-xemacs-popup (poss word cursor-location start end save) - "The XEmacs popup menu." - (let* ((corrects (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))) - (cor-menu (if (consp corrects) - (mapcar (lambda (correct) - (vector correct - (list 'flyspell-do-correct - correct - (list 'quote poss) - word - cursor-location - start - end - save) - t)) - corrects) - '())) - (affix (car (cdr (cdr (cdr poss))))) - show-affix-info - (menu (let ((save (if (and (consp affix) show-affix-info) - (vector - (concat "Save affix: " (car affix)) - (list 'flyspell-do-correct - ''save - (list 'quote poss) - word - cursor-location - start - end - save) - t) - (vector - "Save word" - (list 'flyspell-do-correct - ''save - (list 'quote poss) - word - cursor-location - start - end - save) - t))) - (session (vector "Accept (session)" - (list 'flyspell-do-correct - ''session - (list 'quote poss) - word - cursor-location - start - end - save) - t)) - (buffer (vector "Accept (buffer)" - (list 'flyspell-do-correct - ''buffer - (list 'quote poss) - word - cursor-location - start - end - save) - t))) - (if (consp cor-menu) - (append cor-menu (list "-" save session buffer)) - (list save session buffer))))) - (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary - ispell-dictionary)) - menu)))) - -;;*---------------------------------------------------------------------*/ ;;* Some example functions for real autocorrecting */ ;;*---------------------------------------------------------------------*/ (defun flyspell-maybe-correct-transposition (beg end poss) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index d9a1c7127ff..9747bd6cc12 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,14 +1,9 @@ -;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 +;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*- ;; Copyright (C) 1994-1995, 1997-2017 Free Software Foundation, Inc. ;; Author: Ken Stevens <k.stevens@ieee.org> -;; Maintainer: Ken Stevens <k.stevens@ieee.org> -;; Stevens Mod Date: Mon Jan 7 12:32:44 PST 2003 -;; Stevens Revision: 3.6 ;; Status : Release with 3.1.12+ and 3.2.0+ ispell. -;; Bug Reports : ispell-el-bugs@itcorp.com -;; Web Site : http://kdstevens.com/~stevens/ispell-page.html ;; Keywords: unix wp ;; This file is part of GNU Emacs. @@ -46,9 +41,9 @@ ;; your own dictionaries. ;; Depending on the mail system you use, you may want to include these: -;; (add-hook 'news-inews-hook 'ispell-message) -;; (add-hook 'mail-send-hook 'ispell-message) -;; (add-hook 'mh-before-send-letter-hook 'ispell-message) +;; (add-hook 'news-inews-hook #'ispell-message) +;; (add-hook 'mail-send-hook #'ispell-message) +;; (add-hook 'mh-before-send-letter-hook #'ispell-message) ;; Ispell has a TeX parser and a nroff parser (the default). ;; The parsing is controlled by the variable ispell-parser. Currently @@ -123,153 +118,16 @@ ;; Recursive edits (?C-r or ?R) inside a keyboard text replacement check (?r) ;; can cause misalignment errors. -;; HISTORY - -;; Modifications made in latest versions: - -;; Revision 3.6 2003/01/07 12:32:44 kss -;; Removed extra -d LIB in dictionary defs. (Pavel Janik) -;; Filtered process calls with duplicate dictionary entries. -;; Fixed bug where message-text-end is inside a mime skipped region. -;; Minor fixes to get ispell menus right in XEmacs -;; Fixed skip regexp so it doesn't match stuff like `/.\w'. -;; Detecting dictionary change not working. Fixed. kss -;; function `ispell-change-dictionary' now only completes valid dicts. - -;; Revision 3.5 2001/7/11 18:43:57 kss -;; Added fix for aspell to work in XEmacs (ispell-check-version). -;; Added Portuguese dictionary definition. -;; New feature: MIME mail message support, Fcc support. -;; Bug fix: retain comment syntax on lines with region skipping. (TeX $ bug...) -;; Improved allocation for graphic mode lines. (Miles Bader) -;; Support -v flag for old versions of aspell. (Eli Zaretskii) -;; Clear minibuffer on ^G from ispell-help (Tak Ota) - -;; Revision 3.4 2000/8/4 09:41:50 kss -;; Support new color display functions. -;; Fixed misalignment offset bug when replacing a string after a shift made. -;; Set to standard Author/Maintainer heading, -;; ensure localwords lists are separated from the text by newline. (Dave Love) -;; Added dictionary definition for Italian (William Deakin) -;; HTML region skipping greatly improved. (Chuck D. Phillips) -;; improved menus. Fixed regexp matching http/email addresses. -;; one arg always for XEmacs sleep-for (gunnar Evermann) -;; support for synchronous processes (Eli Zaretskii) - -;; Revision 3.3 1999/11/29 11:38:34 kss -;; Only word replacements entered in from the keyboard are rechecked. -;; This fixes a bug in tex parsing and misalignment. -;; Exceptions exist for recursive edit and query-replace, with tex error -;; condition tested. Recursive editing improved. -;; XEmacs repair for when `enable-multibyte-characters' defined - Didier Verna. -;; ispell-help fixed for XEmacs. Choices minibuffer now displayed in XEmacs. -;; Only list valid dictionaries in Spell menu. Russian dictionary doesn't allow -;; run-together words, and uses koi8-r font. Don't skip text in html <TT> -;; fonts. - -;; Revision 3.2 1999/5/7 14:25:14 kss -;; Accept ispell versions 3.X.Y where X>=1 -;; fine tuned latex region skipping. Fixed bug in ispell-word that did not -;; point in right place on words < 2 chars. Simplified ispell-minor-mode. -;; Fixed bug in TeX parsing when math commands are in the comments. -;; Removed calls to `when' macro. - -;; Revision 3.1 1998/12/1 13:21:52 kss -;; Improved and fixed customize support. -;; Improved and fixed comments in variables and messages. -;; A coding system is now required for all languages. -;; casechars improved for castellano, castellano8, and norsk dictionaries. -;; Dictionary norsk7-tex removed. Dictionary polish added. -;; Dictionaries redefined at load-time to support dictionary changes. -;; Menu redefined at load time to support dictionary changes. -;; ispell-check-version added as an alias for `check-ispell-version'. -;; Spelling suggestions returned in order generated by ispell. -;; Small bug fixed in matching ispell error messages. -;; Robustness added to ensure `case-fold-search' doesn't get redefined. -;; Fixed bug that didn't respect case of word in `ispell-complete-word'. -;; Multibyte character coding support added for process interactions. -;; Ensure ispell process has terminated before starting new process. -;; This can otherwise confuse process filters and hang ispell. -;; Improved skipping support for SGML. -;; Fixed bug using ^M rather than \r in `ispell-minor-check'. -;; Improved message reference matching in `ispell-message'. -;; Fixed bug in returning to nroff mode from tex mode. - -;;; Compatibility code for XEmacs and (not too) older emacsen: - -(eval-and-compile ;; Protect against declare-function undefined in XEmacs - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(declare-function ispell-check-minver "ispell" (v1 v2)) -(declare-function ispell-looking-back "ispell" - (regexp &optional limit &rest ignored)) - -(if (fboundp 'version<=) - (defalias 'ispell-check-minver 'version<=) - (defun ispell-check-minver (minver version) - "Check if string VERSION is at least string MINVER. -Both must be in [0-9]+.[0-9]+... format. This is a fallback -compatibility function in case `version<=' is not available." - (let ((pending t) - (return t) - start-ver start-mver) - ;; Loop until an absolute greater or smaller condition is reached - ;; or until no elements are left in any of version and minver. In - ;; this case version is exactly the minimal, so return OK. - (while pending - (let (ver mver) - (if (string-match "[0-9]+" version start-ver) - (setq start-ver (match-end 0) - ver (string-to-number (match-string 0 version)))) - (if (string-match "[0-9]+" minver start-mver) - (setq start-mver (match-end 0) - mver (string-to-number (match-string 0 minver)))) - - (if (or ver mver) - (progn - (or ver (setq ver 0)) - (or mver (setq mver 0)) - ;; If none of below conditions match, this element is the - ;; same. Go checking next element. - (if (> ver mver) - (setq pending nil) - (if (< ver mver) - (setq pending nil - return nil)))) - (setq pending nil)))) - return))) - -;; XEmacs does not have looking-back -(if (fboundp 'looking-back) - (defalias 'ispell-looking-back 'looking-back) - (defun ispell-looking-back (regexp &optional limit &rest ignored) - "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying a minimum -starting position, to avoid checking matches that would start -before LIMIT. - -This is a stripped down compatibility function for use when -full featured `looking-back' function is missing." - (save-excursion - (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))) - -;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode. -(defmacro ispell-with-no-warnings (&rest body) - (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) - ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar mail-yank-prefix) (defgroup ispell nil "User variables for Emacs ispell interface." :group 'applications) -(if (not (fboundp 'buffer-substring-no-properties)) - (defun buffer-substring-no-properties (start end) - (buffer-substring start end))) - (defalias 'check-ispell-version 'ispell-check-version) ;;; ********************************************************************** @@ -402,19 +260,15 @@ Always stores Fcc copy of message when nil." (defcustom ispell-grep-command - ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they - ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options - ;; below). - (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep") + "grep" "Name of the grep command for search processes." :type 'string :group 'ispell) (defcustom ispell-grep-options - (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i") + "-Ei" "String of options to use when running the program in `ispell-grep-command'. -Should probably be \"-i\" or \"-e\". -Some machines (like the NeXT) don't support \"-i\"." +Should probably be \"-Ei\"." :type 'string :group 'ispell) @@ -491,9 +345,7 @@ window system by evaluating the following on startup to set this variable: ;;;###autoload (defcustom ispell-personal-dictionary nil "File name of your personal spelling dictionary, or nil. -If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or -\"~/.aspell.LANG.pws\" for Aspell) is used, where DICTNAME is the name of your -default dictionary and LANG the two letter language code." +If nil, the default personal dictionary for your spelling checker is used." :type '(choice file (const :tag "default" nil)) :group 'ispell) @@ -810,29 +662,11 @@ here just for backwards compatibility.") "Alist with known matching locales for standard dict names in `ispell-dictionary-base-alist'.") -(defvar ispell-emacs-alpha-regexp - (if (string-match "^[[:alpha:]]+$" "abcde") - "[[:alpha:]]" - nil) - "[[:alpha:]] if Emacs supports [:alpha:] regexp, nil -otherwise (current XEmacs does not support it).") ;;; ********************************************************************** ;;; The following are used by ispell, and should not be changed. ;;; ********************************************************************** - - -;; The version must be 3.1 or greater for this version of ispell.el -;; There is an incompatibility between version 3.1.12 and lower versions. -(defconst ispell-required-version '(3 1 12) - "Ispell versions with which this version of ispell.el is known to work.") -(defvar ispell-offset -1 - "Offset that maps protocol differences between ispell 3.1 versions.") - -(defconst ispell-version "ispell.el 3.6 - 7-Jan-2003") - - (defun ispell-check-version (&optional interactivep) "Ensure that `ispell-program-name' is valid and has the correct version. Returns version number if called interactively. @@ -848,7 +682,12 @@ Otherwise returns the library directory name, if that is defined." (let ((default-directory (or (and (boundp 'temporary-file-directory) temporary-file-directory) default-directory)) - result status ispell-program-version) + (get-config-var + (lambda (var) + (when (re-search-forward + (concat var " = \\\"\\(.+?\\)\\\"") nil t) + (match-string 1)))) + result libvar status ispell-program-version) (with-temp-buffer (setq status (ispell-call-process @@ -862,17 +701,19 @@ Otherwise returns the library directory name, if that is defined." (if (string-match "\\`aspell" speller) "-v" "-vv")))) (goto-char (point-min)) (if interactivep - ;; Report version information of ispell and ispell.el + ;; Report version information of ispell (progn (end-of-line) - (setq result (concat (buffer-substring-no-properties (point-min) - (point)) - ", " - ispell-version)) + (setq result (buffer-substring-no-properties (point-min) + (point))) (message "%s" result)) - ;; return library directory. - (if (re-search-forward "LIBDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t) - (setq result (match-string 1)))) + ;; return LIBDIR or LIBRARYVAR (overrides LIBDIR) env. + (progn + (setq result (funcall get-config-var "LIBDIR") + libvar (funcall get-config-var "LIBRARYVAR")) + (when libvar + (setq libvar (getenv libvar)) + (unless (member libvar '(nil "")) (setq result libvar))))) (goto-char (point-min)) (if (not (memq status '(0 nil))) (error "%s exited with %s %s" ispell-program-name @@ -886,8 +727,7 @@ Otherwise returns the library directory name, if that is defined." ;; Make sure these variables are (re-)initialized to the default value (setq ispell-really-aspell nil - ispell-aspell-supports-utf8 nil - ispell-really-hunspell nil + ispell-really-hunspell nil ispell-encoding8-command nil) (goto-char (point-min)) @@ -901,29 +741,26 @@ Otherwise returns the library directory name, if that is defined." nil t) (match-string 1))))) - (let ((aspell-minver "0.50") - (aspell8-minver "0.60") - (ispell0-minver "3.1.0") - (ispell-minver "3.1.12") - (hunspell8-minver "1.1.6")) - - (if (ispell-check-minver ispell0-minver ispell-program-version) - (or (ispell-check-minver ispell-minver ispell-program-version) - (setq ispell-offset 0)) - (error "%s release %s or greater is required" - ispell-program-name - ispell-minver)) + (let* ((aspell8-minver "0.60") + (ispell-minver "3.1.12") + (hunspell8-minver "1.1.6") + (minver (cond + ((not (version<= ispell-minver ispell-program-version)) + ispell-minver) + ((and ispell-really-aspell + (not (version<= aspell8-minver ispell-really-aspell))) + aspell8-minver)))) + + (if minver + (error "%s release %s or greater is required" + ispell-program-name + minver)) (cond (ispell-really-aspell - (if (ispell-check-minver aspell-minver ispell-really-aspell) - (if (ispell-check-minver aspell8-minver ispell-really-aspell) - (progn - (setq ispell-aspell-supports-utf8 t) - (setq ispell-encoding8-command "--encoding="))) - (setq ispell-really-aspell nil))) + (setq ispell-encoding8-command "--encoding=")) (ispell-really-hunspell - (if (ispell-check-minver hunspell8-minver ispell-really-hunspell) + (if (version<= hunspell8-minver ispell-really-hunspell) (setq ispell-encoding8-command "-i") (setq ispell-really-hunspell nil)))))) result)) @@ -942,6 +779,8 @@ Otherwise returns the library directory name, if that is defined." (setq default-directory (expand-file-name "~/"))) (apply 'call-process-region args))) +(defvar ispell-debug-buffer) + (defun ispell-create-debug-buffer (&optional append) "Create an ispell debug buffer for debugging output. If APPEND is non-nil, append the info to previous buffer if exists, @@ -972,22 +811,10 @@ See `ispell-buffer-with-debug' for an example of use." ;; Redo menu when loading ispell to get dictionary modifications (setq ispell-menu-map nil) -;;;###autoload -(defvar ispell-menu-xemacs nil - "Spelling menu for XEmacs. -If nil when package is loaded, a standard menu will be set, -and added as a submenu of the \"Edit\" menu.") - -;; Break out XEmacs menu and split into several calls to avoid having -;; long lines in loaddefs.el. Detect need off following constant. - ;;; Set up dictionary ;;;###autoload (defvar ispell-menu-map-needed - ;; only needed when not version 18 and not XEmacs. - (and (not ispell-menu-map) - (not (featurep 'xemacs)) - 'reload)) + (unless ispell-menu-map 'reload)) (defvar ispell-library-directory (condition-case () (ispell-check-version) @@ -999,11 +826,7 @@ and added as a submenu of the \"Edit\" menu.") (defvar ispell-async-processp (and (fboundp 'delete-process) (fboundp 'process-send-string) - (fboundp 'accept-process-output) - ;;(fboundp 'make-process) - ;;(fboundp 'set-process-filter) - ;;(fboundp 'process-kill-without-query) - ) + (fboundp 'accept-process-output)) "Non-nil means that the OS supports asynchronous processes.") ;; Make ispell.el work better with aspell. @@ -1013,9 +836,7 @@ and added as a submenu of the \"Edit\" menu.") Internal use.") (defun ispell-find-aspell-dictionaries () - "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'." - (unless (and ispell-really-aspell ispell-encoding8-command) - (error "This function only works with Aspell >= 0.60")) + "Find Aspell's dictionaries, and record in `ispell-aspell-dictionary-alist'." (let* ((dictionaries (split-string (with-temp-buffer @@ -1182,15 +1003,15 @@ all uninitialized dicts using that affix file." (if (cadr (assoc tmp-dict ispell-dictionary-alist)) (ispell-print-if-debug "ispell-hfde: %s already expanded; skipping.\n" tmp-dict) - (add-to-list 'use-for-dicts tmp-dict)))))) + (cl-pushnew tmp-dict use-for-dicts :test #'equal)))))) (ispell-print-if-debug "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts) ;; The final loop. (dolist (entry ispell-dictionary-alist) - (if (member (car entry) use-for-dicts) - (add-to-list 'newlist - (append (list (car entry)) dict-args-cdr)) - (add-to-list 'newlist entry))) + (cl-pushnew (if (member (car entry) use-for-dicts) + (cons (car entry) dict-args-cdr) + entry) + newlist :test #'equal)) (setq ispell-dictionary-alist newlist)))) (defun ispell-parse-hunspell-affix-file (dict-key) @@ -1235,7 +1056,7 @@ did." (chars-list (append otherchars-string nil))) (setq chars-list (delq ?\ chars-list)) (dolist (ch chars-list) - (add-to-list 'otherchars-list ch))))) + (cl-pushnew ch otherchars-list :test #'equal))))) ;; Cons the argument for the -d switch. (setq dict-arg (concat dict-arg (if (> (length dict-arg) 0) ",") @@ -1246,7 +1067,7 @@ did." "[[:alpha:]]" "[^[:alpha:]]" (if otherchars-list - (regexp-opt (mapcar 'char-to-string otherchars-list)) + (regexp-opt (mapcar #'char-to-string otherchars-list)) "") t ; many-otherchars-p: We can't tell, set to t. (list "-d" dict-arg) @@ -1268,7 +1089,7 @@ in the list must have an affix file where Hunspell affix files are kept." (or (assoc first-dict ispell-local-dictionary-alist) (assoc first-dict ispell-dictionary-alist) (error "Unknown dictionary: %s" first-dict))) - (add-to-list 'ispell-dictionary-alist (list dict '())) + (cl-pushnew (list dict '()) ispell-dictionary-alist :test #'equal) (ispell-hunspell-fill-dictionary-entry dict)) (defun ispell-find-hunspell-dictionaries () @@ -1308,8 +1129,8 @@ entries if a specific dictionary was found." (ispell-print-if-debug "++ ispell-fhd: dict-entry:%s name:%s basename:%s affix-file:%s\n" dict full-name basename affix-file) - (add-to-list 'ispell-hunspell-dict-paths-alist - (list basename affix-file))) + (cl-pushnew (list basename affix-file) + ispell-hunspell-dict-paths-alist :test #'equal)) (ispell-print-if-debug "-- ispell-fhd: Skipping entry: %s\n" dict))))) ;; Remove entry from aliases alist if explicit dict was found. @@ -1319,7 +1140,7 @@ entries if a specific dictionary was found." (ispell-print-if-debug "-- ispell-fhd: Excluding %s alias. Standalone dict found.\n" (car dict)) - (add-to-list 'newlist dict))) + (cl-pushnew dict newlist :test #'equal))) (setq ispell-dicts-name2locale-equivs-alist newlist)) ;; Add known hunspell aliases (dolist (dict-equiv ispell-dicts-name2locale-equivs-alist) @@ -1337,22 +1158,20 @@ entries if a specific dictionary was found." ispell-hunspell-dict-paths-alist)))) (ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n" dict-equiv-key affix-file) - (add-to-list - 'ispell-hunspell-dict-paths-alist - (list dict-equiv-key affix-file)))))) + (cl-pushnew (list dict-equiv-key affix-file) + ispell-hunspell-dict-paths-alist :test #'equal))))) ;; Parse and set values for default dictionary. (setq hunspell-default-dict (car hunspell-default-dict)) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. (setq ispell-hunspell-dictionary-alist - (list (append (list nil) (cdr hunspell-default-dict-entry)))) - (dolist (dict (mapcar 'car ispell-hunspell-dict-paths-alist)) - (if (string= dict hunspell-default-dict) - (add-to-list 'ispell-hunspell-dictionary-alist - hunspell-default-dict-entry) - (add-to-list 'ispell-hunspell-dictionary-alist - (list dict)))))) + (list (cons nil (cdr hunspell-default-dict-entry)))) + (dolist (dict (mapcar #'car ispell-hunspell-dict-paths-alist)) + (cl-pushnew (if (string= dict hunspell-default-dict) + hunspell-default-dict-entry + (list dict)) + ispell-hunspell-dictionary-alist :test #'equal)))) ;; Set params according to the selected spellchecker @@ -1379,11 +1198,9 @@ aspell is used along with Emacs).") (setq ispell-library-directory (ispell-check-version)) t) (error nil)) - ispell-encoding8-command - ispell-emacs-alpha-regexp) + ispell-encoding8-command) ;; auto-detection will only be used if spellchecker is not - ;; ispell, supports a way to set communication to UTF-8 and - ;; Emacs flavor supports [:alpha:] + ;; ispell and supports a way to set communication to UTF-8. (if ispell-really-aspell (or ispell-aspell-dictionary-alist (ispell-find-aspell-dictionaries)) @@ -1397,9 +1214,8 @@ aspell is used along with Emacs).") ;; installed dictionaries and add to it elements of the original ;; list that are not present there. Allow distro info. (let ((found-dicts-alist - (if (and ispell-encoding8-command - ispell-emacs-alpha-regexp) - (if ispell-really-aspell + (if ispell-encoding8-command + (if ispell-really-aspell ispell-aspell-dictionary-alist (if ispell-really-hunspell ispell-hunspell-dictionary-alist)) @@ -1443,80 +1259,83 @@ aspell is used along with Emacs).") (setq skip-dict t))) (unless skip-dict - (add-to-list 'tmp-dicts-alist - (list - dict-name ; dict name - (nth 1 adict) ; casechars - (nth 2 adict) ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - ispell-args ; ispell-args - (nth 6 adict) ; extended-character-mode - (nth 7 adict) ; dict encoding - )))) + (cl-pushnew (list + dict-name ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + ispell-args ; ispell-args + (nth 6 adict) ; extended-character-mode + (nth 7 adict) ; dict encoding + ) + tmp-dicts-alist :test #'equal))) (setq ispell-dictionary-base-alist tmp-dicts-alist)))) (run-hooks 'ispell-initialize-spellchecker-hook) - ;; Add dicts to ``ispell-dictionary-alist'' unless already present. + ;; Add dicts to `ispell-dictionary-alist' unless already present. (dolist (dict (append found-dicts-alist ispell-base-dicts-override-alist ispell-dictionary-base-alist)) (unless (assoc (car dict) all-dicts-alist) - (add-to-list 'all-dicts-alist dict))) + (push dict all-dicts-alist))) (setq ispell-dictionary-alist all-dicts-alist)) - ;; If Emacs flavor supports [:alpha:] use it for global dicts. If - ;; spellchecker also supports UTF-8 via command-line option use it + ;; If spellchecker supports UTF-8 via command-line option, use it ;; in communication. This does not affect definitions in your ;; init file. - (if ispell-emacs-alpha-regexp - (let (tmp-dicts-alist) - (dolist (adict ispell-dictionary-alist) - (if (cadr adict) ;; Do not touch hunspell uninitialized entries - (add-to-list 'tmp-dicts-alist - (list - (nth 0 adict) ; dict name - "[[:alpha:]]" ; casechars - "[^[:alpha:]]" ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - (nth 5 adict) ; ispell-args - (nth 6 adict) ; extended-character-mode - (if ispell-encoding8-command - 'utf-8 - (nth 7 adict)))) - (add-to-list 'tmp-dicts-alist adict))) - (setq ispell-dictionary-alist tmp-dicts-alist))))) + (let (tmp-dicts-alist) + (dolist (adict ispell-dictionary-alist) + (cl-pushnew (if (cadr adict) ;; Do not touch hunspell uninitialized entries + (list + (nth 0 adict) ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + (nth 5 adict) ; ispell-args + (nth 6 adict) ; extended-character-mode + (if ispell-encoding8-command + 'utf-8 + (nth 7 adict))) + adict) + tmp-dicts-alist :test #'equal)) + (setq ispell-dictionary-alist tmp-dicts-alist)))) (defun ispell-valid-dictionary-list () "Return a list of valid dictionaries. The variable `ispell-library-directory' defines their location." ;; Initialize variables and dictionaries alists for desired spellchecker. - ;; Make sure ispell.el is loaded to avoid some autoload loops in XEmacs - ;; (and may be others) + ;; Make sure ispell.el is loaded to avoid some autoload loops. (if (featurep 'ispell) (ispell-set-spellchecker-params)) (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist)) (dict-list (cons "default" nil)) - name dict-bname) + (dict-locate + (lambda (dict &optional dir) + (locate-file (file-name-nondirectory dict) + `(,(or dir (file-name-directory dict))) + (unless (file-name-extension dict) '(".hash" ".has"))))) + name dict-explt dict-bname) (dolist (dict dicts) (setq name (car dict) - dict-bname (or (car (cdr (member "-d" (nth 5 dict)))) - name)) - ;; Include if the dictionary is in the library, or dir not defined. - (if (and - name - ;; For Aspell, we already know which dictionaries exist. - (or ispell-really-aspell - ;; Include all dictionaries if lib directory not known. - ;; Same for Hunspell, where ispell-library-directory is nil. - (not ispell-library-directory) - (file-exists-p (concat ispell-library-directory - "/" dict-bname ".hash")) - (file-exists-p (concat ispell-library-directory - "/" dict-bname ".has")))) + ;; Explicitly (via ispell-args) specified dictionary. + dict-explt (car (cdr (member "-d" (nth 5 dict)))) + dict-bname (or dict-explt name)) + (if (and name + (or + ;; Include all for Aspell (we already know existing dicts) + ispell-really-aspell + ;; Include all if `ispell-library-directory' is nil (Hunspell) + (not ispell-library-directory) + ;; If explicit (-d with an absolute path) and existing dict. + (and dict-explt + (file-name-absolute-p dict-explt) + (funcall dict-locate dict-explt)) + ;; If dict located in `ispell-library-directory'. + (funcall dict-locate dict-bname ispell-library-directory))) (push name dict-list))) dict-list)) @@ -1592,65 +1411,8 @@ The variable `ispell-library-directory' defines their location." (define-key ispell-menu-map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) - ;;(put 'ispell-region 'menu-enable 'mark-active) (fset 'ispell-menu-map (symbol-value 'ispell-menu-map)))) -;;; XEmacs versions 19 & 20 -(if (and (featurep 'xemacs) - (featurep 'menubar) - ;;(null ispell-menu-xemacs) - (not (and (boundp 'infodock-version) infodock-version))) - (let ((dicts (if (fboundp 'ispell-valid-dictionary-list) - (reverse (ispell-valid-dictionary-list)))) - (current-menubar (or current-menubar default-menubar)) - (menu - '(["Help" (describe-function 'ispell-help) t] - ;;["Help" (popup-menu ispell-help-list) t] - ["Check Message" ispell-message t] - ["Check Buffer" ispell-buffer t] - ["Check Comments" ispell-comments-and-strings t] - ["Check Word" ispell-word t] - ["Check Region" ispell-region (or (not zmacs-regions) (mark))] - ["Continue Check" ispell-continue t] - ["Complete Word Frag"ispell-complete-word-interior-frag t] - ["Complete Word" ispell-complete-word t] - ["Kill Process" (ispell-kill-ispell nil 'clear) t] - ["Customize..." (customize-group 'ispell) t] - ;; flyspell-mode may not be bound... - ;;["flyspell" flyspell-mode - ;; :style toggle :selected flyspell-mode ] - "-" - ["Save Personal Dict"(ispell-pdict-save t t) t] - ["Change Dictionary" ispell-change-dictionary t]))) - (if (null dicts) - (setq dicts (cons "default" nil))) - (dolist (name dicts) - (setq menu (append menu - (list - (vector - (concat "Select " (capitalize name)) - (list 'ispell-change-dictionary name) - t))))) - (setq ispell-menu-xemacs menu) - (if current-menubar - (progn - (if (car (find-menu-item current-menubar '("Cmds"))) - (progn - ;; XEmacs 21.2 - (delete-menu-item '("Cmds" "Spell-Check")) - (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs)) - ;; previous - (delete-menu-item '("Edit" "Spell")) ; in case already defined - (add-menu '("Edit") "Spell" ispell-menu-xemacs)))))) - -(defalias 'ispell-int-char - ;; Allow incrementing characters as integers in XEmacs 20 - (if (and (featurep 'xemacs) - (fboundp 'int-char)) - 'int-char - ;; Emacs and XEmacs 19 or earlier - 'identity)) - ;;; ********************************************************************** @@ -1664,17 +1426,8 @@ used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.") This is passed to the Ispell process using the `-p' switch.") (defun ispell-decode-string (str) - "Decodes multibyte character strings. -Protects against bogus binding of `enable-multibyte-characters' in XEmacs." - ;; FIXME: enable-multibyte-characters is read-only, so bogus bindings are - ;; really nasty (they signal an error in Emacs): Who does that? --Stef - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'decode-coding-string) - (ispell-get-coding-system)) - (decode-coding-string str (ispell-get-coding-system)) - str)) + "Decodes multibyte character strings." + (decode-coding-string str (ispell-get-coding-system))) ;; Return a string decoded from Nth element of the current dictionary. (defun ispell-get-decoded-string (n) @@ -1875,6 +1628,7 @@ Valid forms include: ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ;;("\\\\author" ispell-tex-arg-end) + ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) @@ -2132,32 +1886,20 @@ quit spell session exited." (cond ((eq poss t) (or quietly (message "%s is correct" - (funcall ispell-format-word-function word))) - (and (featurep 'xemacs) - (extent-at start) - (and (fboundp 'delete-extent) - (delete-extent (extent-at start))))) + (funcall ispell-format-word-function word)))) ((stringp poss) (or quietly (message "%s is correct because of root %s" (funcall ispell-format-word-function word) - (funcall ispell-format-word-function poss))) - (and (featurep 'xemacs) - (extent-at start) - (and (fboundp 'delete-extent) - (delete-extent (extent-at start))))) + (funcall ispell-format-word-function poss)))) ((null poss) (message "Error checking word %s using %s with %s dictionary" (funcall ispell-format-word-function word) (file-name-nondirectory ispell-program-name) (or ispell-current-dictionary "default"))) (ispell-check-only ; called from ispell minor mode. - (if (fboundp 'make-extent) - (if (fboundp 'set-extent-property) - (let ((ext (make-extent start end))) - (set-extent-property ext 'face ispell-highlight-face) - (set-extent-property ext 'priority 2000))) - (beep) + (progn + (beep) (message "%s is incorrect" (funcall ispell-format-word-function word)))) (t ; prompt for correct word. @@ -2327,15 +2069,9 @@ Global `ispell-quit' set to start location to continue spell session." "-- %b -- word: " word " -- dict: " (or ispell-current-dictionary "default") " -- prog: " (file-name-nondirectory ispell-program-name))) - ;; XEmacs: no need for horizontal scrollbar in choices window - (ispell-with-no-warnings - (and (fboundp 'set-specifier) - (boundp 'horizontal-scrollbar-visible-p) - (set-specifier horizontal-scrollbar-visible-p nil - (cons (current-buffer) nil)))) - (ispell-with-no-warnings - (and (boundp 'horizontal-scroll-bar) - (setq horizontal-scroll-bar nil))) + ;; No need for horizontal scrollbar in choices window + (with-no-warnings + (setq horizontal-scroll-bar nil)) (erase-buffer) (if guess (progn @@ -2358,12 +2094,12 @@ Global `ispell-quit' set to start location to continue spell session." ;; not so good if there are over 20 or 30 options, but then, if ;; there are that many you don't want to scan them all anyway... (while (memq count command-characters) ; skip command characters. - (setq count (ispell-int-char (1+ count)) + (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) - count (ispell-int-char (1+ count)))) - (setq count (ispell-int-char (- count ?0 skipped)))) + count (1+ count))) + (setq count (- count ?0 skipped))) (run-hooks 'ispell-update-post-hook) @@ -2422,14 +2158,15 @@ Global `ispell-quit' set to start location to continue spell session." ((= char ?i) ; accept and insert word into pers dict (ispell-send-string (concat "*" word "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! - (and (fboundp 'flyspell-unhighlight-at) - (flyspell-unhighlight-at start)) + (when (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) - (add-to-list 'ispell-buffer-session-localwords word) - (and (fboundp 'flyspell-unhighlight-at) - (flyspell-unhighlight-at start)) + (cl-pushnew word ispell-buffer-session-localwords + :test #'equal) + (when (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict (setq ispell-buffer-local-name (buffer-name))) (if (null ispell-pdict-modified-p) @@ -2509,13 +2246,12 @@ Global `ispell-quit' set to start location to continue spell session." (window-width)) (insert "\n")) (while (memq count command-characters) - (setq count (ispell-int-char (1+ count)) + (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) - count (ispell-int-char (1+ count)))) - (setq count (ispell-int-char - (- count ?0 skipped)))) + count (1+ count))) + (setq count (- count ?0 skipped))) (setq textwin (selected-window)) (ispell-show-choices) (select-window textwin)))) @@ -2682,8 +2418,8 @@ SPC: Accept word this time. (defun ispell-lookup-words (word &optional lookup-dict) "Look up WORD in optional word-list dictionary LOOKUP-DICT. A `*' serves as a wild card. If no wild cards, `look' is used if it exists. -Otherwise the variable `ispell-grep-command' contains the command used to -search for the words (usually egrep). +Otherwise the variable `ispell-grep-command' contains the command +\(usually \"grep\") used to search for the words. Optional second argument contains the dictionary to use; the default is `ispell-alternate-dictionary', overridden by `ispell-complete-word-dict' @@ -2760,7 +2496,7 @@ if defined." ;; This is the case when a process dies or fails. The default behavior ;; in this case treats the next input received as fresh input. -(defun ispell-filter (process output) +(defun ispell-filter (_process output) "Output filter function for ispell, grep, and look." (let ((start 0) (continue t) @@ -2828,17 +2564,6 @@ Optional REFRESH will unhighlighted then highlight, using block cursor (if (eq 'block refresh) start (- start 2)) end t)))) -(defun ispell-highlight-spelling-error-xemacs (start end &optional highlight) - "Highlight the word from START to END using `isearch-highlight'. -When the optional third arg HIGHLIGHT is set, the word is highlighted, -otherwise it is displayed normally." - (if highlight - (isearch-highlight start end) - (isearch-dehighlight)) - ;;(sit-for 0) - ) - - (defun ispell-highlight-spelling-error-overlay (start end &optional highlight) "Highlight the word from START to END using overlays. When the optional third arg HIGHLIGHT is set, the word is highlighted @@ -2874,14 +2599,9 @@ The variable `ispell-highlight-face' selects the face to use for highlighting." (defun ispell-highlight-spelling-error (start end &optional highlight refresh) - (cond - ((featurep 'xemacs) - (ispell-highlight-spelling-error-xemacs start end highlight)) - ((and (featurep 'faces) - (or (and (fboundp 'display-color-p) (display-color-p)) - window-system)) - (ispell-highlight-spelling-error-overlay start end highlight)) - (t (ispell-highlight-spelling-error-generic start end highlight refresh)))) + (if (display-color-p) + (ispell-highlight-spelling-error-overlay start end highlight) + (ispell-highlight-spelling-error-generic start end highlight refresh))) (defun ispell-display-buffer (buffer) "Show BUFFER in new window above selected one. @@ -3040,17 +2760,14 @@ Keeps argument list for future Ispell invocations for no async support." (ispell-send-string "\032\n") ; so Ispell prints version and exits t))) - (defun ispell-init-process () "Check status of Ispell process and start if necessary." (let* (;; Basename of dictionary used by the spell-checker (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) ispell-current-dictionary)) - ;; The directory where process was started. - (current-ispell-directory default-directory) ;; The default directory for the process. ;; Use "~/" as default-directory unless using Ispell with per-dir - ;; personal dictionaries and not in a minibuffer under XEmacs + ;; personal dictionaries (default-directory (if (or ispell-really-aspell ispell-really-hunspell @@ -3063,9 +2780,8 @@ Keeps argument list for future Ispell invocations for no async support." ".ispell_" (or dict-bname "default"))))) - ;; Ispell, in a minibuffer, and XEmacs - (and (window-minibuffer-p) - (not (fboundp 'minibuffer-selected-window)))) + ;; Ispell, in a minibuffer + (window-minibuffer-p)) (expand-file-name "~/") (expand-file-name default-directory)))) ;; Check if process needs restart @@ -3097,29 +2813,21 @@ Keeps argument list for future Ispell invocations for no async support." (unless (equal ispell-process-directory (expand-file-name "~/")) ;; At this point, `ispell-process-directory' will be "~/" unless using - ;; Ispell with directory-specific dicts and not in XEmacs minibuffer. + ;; Ispell with directory-specific dicts. ;; If not, kill ispell process when killing buffer. It may be in a ;; removable device that would otherwise become un-mountable. (with-current-buffer - (if (and (window-minibuffer-p) ;; In minibuffer - (fboundp 'minibuffer-selected-window)) ;; Not XEmacs. + (if (window-minibuffer-p) ;; In minibuffer ;; In this case kill ispell only when parent buffer is killed ;; to avoid over and over ispell kill. (window-buffer (minibuffer-selected-window)) (current-buffer)) - ;; 'local does not automatically make hook buffer-local in XEmacs. - (if (featurep 'xemacs) - (make-local-hook 'kill-buffer-hook)) - (add-hook 'kill-buffer-hook + (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) nil 'local))) (if ispell-async-processp (set-process-filter ispell-process 'ispell-filter)) - ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'. - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'set-process-coding-system) + (if (and enable-multibyte-characters ;; Evidently, some people use the synchronous mode even ;; when async subprocesses are supported, in which case ;; set-process-coding-system is bound, but @@ -3150,17 +2858,13 @@ Keeps argument list for future Ispell invocations for no async support." ;; Otherwise we get cool errors like "Can't open ". (sleep-for 1) (ispell-accept-output 3) - (error "%s" (mapconcat 'identity ispell-filter "\n")))) + (error "%s" (mapconcat #'identity ispell-filter "\n")))) (setq ispell-filter nil) ; Discard version ID line (let ((extended-char-mode (ispell-get-extended-character-mode))) (if extended-char-mode ; ~ extended character mode (ispell-send-string (concat extended-char-mode "\n")))) - (if ispell-async-processp - (if (featurep 'emacs) - (set-process-query-on-exit-flag ispell-process nil) - (if (fboundp 'set-process-query-on-exit-flag) - (set-process-query-on-exit-flag ispell-process nil) - (process-kill-without-query ispell-process))))))) + (when ispell-async-processp + (set-process-query-on-exit-flag ispell-process nil))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error clear) @@ -3172,9 +2876,7 @@ With CLEAR, buffer session localwords are cleaned." ;; to optimize the common cases. (run-hooks 'ispell-kill-ispell-hook) (if (or clear - (if (featurep 'xemacs) - (interactive-p) - (called-interactively-p 'interactive))) + (called-interactively-p 'interactive)) (setq ispell-buffer-session-localwords nil)) (if (not (and ispell-process (eq (ispell-process-status) 'run))) @@ -3206,7 +2908,7 @@ By just answering RET you can find out what the current dictionary is." (list (completing-read "Use new dictionary (RET for current, SPC to complete): " (and (fboundp 'ispell-valid-dictionary-list) - (mapcar 'list (ispell-valid-dictionary-list))) + (mapcar #'list (ispell-valid-dictionary-list))) nil t) current-prefix-arg)) (ispell-set-spellchecker-params) ; Initialize variables and dicts alists @@ -3223,9 +2925,7 @@ By just answering RET you can find out what the current dictionary is." ;; Specified dictionary is the default already. Could reload ;; the dictionaries if needed. (ispell-internal-change-dictionary) - (and (if (featurep 'xemacs) - (interactive-p) - (called-interactively-p 'interactive)) + (when (called-interactively-p 'interactive) (message "No change, using %s dictionary" dict))) (t ; reset dictionary! (if (or (assoc dict ispell-local-dictionary-alist) @@ -3412,7 +3112,7 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys. Must be called after `ispell-buffer-local-parsing' due to dependence on mode." (mapconcat - 'identity + #'identity (delq nil (list ;; messages @@ -3433,7 +3133,14 @@ Must be called after `ispell-buffer-local-parsing' due to dependence on mode." (if (string= "" comment-end) "^" (regexp-quote comment-end))) (if (and (null ispell-check-comments) comment-start) (regexp-quote comment-start)) - (ispell-begin-skip-region ispell-skip-region-alist) + ;; If they set ispell-skip-region-alist to nil, mapconcat + ;; will produce an empty string, which will then match + ;; anything without moving point, something + ;; ispell-skip-region doesn't expect. Perhaps we should be + ;; more defensive and delq "" above as well, in addition to + ;; deleting nil elements. + (if ispell-skip-region-alist + (ispell-begin-skip-region ispell-skip-region-alist)) (ispell--make-filename-or-URL-re))) "\\|")) @@ -3638,7 +3345,10 @@ Returns the sum SHIFT due to changes in word replacements." ;; Markers can move with highlighting! This destroys ;; end of region markers line-end and ispell-region-end (let ((word-start - (copy-marker (+ ispell-start ispell-offset (car (cdr poss))))) + ;; There is a -1 offset here as the string is escaped + ;; with '^' to prevent us accidentally sending any + ;; ispell commands. + (copy-marker (+ ispell-start -1 (car (cdr poss))))) (word-len (length (car poss))) (line-end (copy-marker ispell-end)) (line-start (copy-marker ispell-start)) @@ -3869,7 +3579,7 @@ Standard ispell choices are then available." (setq case-fold-search nil) ; Try and respect case of word. (cond ((string-equal (upcase word) word) - (setq possibilities (mapcar 'upcase possibilities))) + (setq possibilities (mapcar #'upcase possibilities))) ((eq (upcase (aref word 0)) (aref word 0)) (setq possibilities (mapcar (function (lambda (pos) @@ -4103,10 +3813,10 @@ The `X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your init file: - (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5 - (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4 - (add-hook \\='mail-send-hook \\='ispell-message) - (add-hook \\='mh-before-send-letter-hook \\='ispell-message) + (add-hook \\='message-send-hook #\\='ispell-message) ;; GNUS 5 + (add-hook \\='news-inews-hook #\\='ispell-message) ;; GNUS 4 + (add-hook \\='mail-send-hook #\\='ispell-message) + (add-hook \\='mh-before-send-letter-hook #\\='ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: @@ -4135,29 +3845,23 @@ You can bind this to the key C-c i in GNUS or mail by adding to (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (default-prefix ; Vanilla cite prefix (just used for cite-regexp) - (if (and (boundp 'mail-yank-prefix) mail-yank-prefix) - (ispell-non-empty-string mail-yank-prefix) + (if (ispell-non-empty-string mail-yank-prefix) " \\|\t")) (cite-regexp ;Prefix of quoted text (cond - ((functionp 'sc-cite-regexp) ; sc 3.0 - (ispell-with-no-warnings + ((functionp 'sc-cite-regexp) ; supercite >= 3.0 + (with-no-warnings (concat "\\(" (sc-cite-regexp) "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string)))) - ((boundp 'sc-cite-regexp) ; sc 2.3 - (concat "\\(" sc-cite-regexp "\\)" "\\|" - (ispell-with-no-warnings - (ispell-non-empty-string sc-reference-tag-string)))) - ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below - (equal major-mode 'message-mode)) ;GNUS 5 + ((equal major-mode 'message-mode) ; GNUS >= 5 (concat "In article <" "\\|" "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|" - (ispell-with-no-warnings message-cite-prefix-regexp) + (with-no-warnings message-cite-prefix-regexp) "\\|" default-prefix)) ((equal major-mode 'mh-letter-mode) ; mh mail message (concat "[^,;&+=\n]+ writes:" "\\|" - (ispell-with-no-warnings + (with-no-warnings (ispell-non-empty-string mh-ins-buf-prefix)))) ((not internal-messagep) ; Assume nn sent us this message. (concat "In [a-zA-Z.]+ you write:" "\\|" @@ -4381,8 +4085,8 @@ Both should not be used to define a buffer-local dictionary." ;; Returns optionally adjusted region-end-point. -;; If comment-padright is defined, newcomment must be loaded. -(declare-function comment-add "newcomment" (arg)) +;; If comment-normalize-vars is defined, newcomment must be loaded. +(declare-function comment-normalize-vars "newcomment" (&optional noerror)) (defun ispell-add-per-file-word-list (word) "Add WORD to the per-file word list." @@ -4408,16 +4112,12 @@ Both should not be used to define a buffer-local dictionary." (unless found (newline)) (insert (if comment-start (concat - (if (fboundp 'comment-padright) - ;; Try and use the proper comment marker, - ;; e.g. ";;" rather than ";". - (progn - ;; XEmacs: comment-normalize-vars - ;; (newcomment.el) only in >= 21.5 - (and (fboundp 'comment-normalize-vars) - (comment-normalize-vars)) - (comment-padright comment-start - (comment-add nil))) + (progn + ;; Try and use the proper comment marker, + ;; e.g. ";;" rather than ";". + (comment-normalize-vars) + (comment-padright comment-start + (comment-add nil)) comment-start) " ") "") @@ -4428,6 +4128,7 @@ Both should not be used to define a buffer-local dictionary." (insert comment-end))))) (insert (concat " " word)))))))) +;;FIXME: Use `user-error' instead! (add-to-list 'debug-ignored-errors "^No word found to check!$") (provide 'ispell) @@ -4465,6 +4166,6 @@ Both should not be used to define a buffer-local dictionary." ; LocalWords: minipage pers dict unhighlight buf grep sync prev inc ; LocalWords: fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg ; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict -; LocalWords: lns XEmacs HTML casechars Multibyte +; LocalWords: lns HTML casechars Multibyte ;;; ispell.el ends here diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index 17b999009de..cea0c604baf 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -37,7 +37,7 @@ (defgroup nroff nil "Nroff mode." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :group 'wp + :group 'text :prefix "nroff-") diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 8f8c0afe64c..8542b951b3b 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -694,20 +694,14 @@ Used by `pages-directory' function." (terpri)) (end-of-line 1))) -(defun pages-directory-mode () +(define-derived-mode pages-directory-mode special-mode "Pages-Directory" "Mode for handling the pages-directory buffer. Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go to the same line in the pages buffer." - - (kill-all-local-variables) - (use-local-map pages-directory-mode-map) - (setq major-mode 'pages-directory-mode) - (setq mode-name "Pages-Directory") (make-local-variable 'pages-buffer) (make-local-variable 'pages-pos-list) - (make-local-variable 'pages-directory-buffer-narrowing-p) - (run-mode-hooks 'pages-directory-mode-hook)) + (make-local-variable 'pages-directory-buffer-narrowing-p)) (defun pages-directory-goto () "Go to the corresponding line in the pages buffer." diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index c5de28e9935..09d0a2f0a9a 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -33,7 +33,7 @@ (defgroup picture nil "Editing text-based pictures (\"ASCII art\")." :prefix "picture-" - :group 'wp) + :group 'text) (defcustom picture-rectangle-ctl ?+ "Character `picture-draw-rectangle' uses for top left corners." diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index 5cfc6ef6406..6b721260813 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -61,7 +61,7 @@ (defgroup refbib nil "Convert refer-style references to ones usable by Latex bib." :prefix "r2b-" - :group 'wp) + :group 'text) (defcustom r2b-trace-on nil "Non-nil means trace conversion." diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 68641f1be40..1843c8e9ede 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -73,7 +73,7 @@ (defgroup refer nil "Look up references in bibliography files." :prefix "refer-" - :group 'wp) + :group 'text) (defcustom refer-bib-directory nil "Directory, or list of directories, to search for \\.bib files. diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index ca33fa38a28..1e0a5640483 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -237,5 +237,5 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See ;;; reftex-auc.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index f7fc2a9b776..7f1887cbf45 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -73,7 +73,7 @@ The expanded value is cached." ;;;###autoload (defun reftex-bib-or-thebib () - "Test if BibTeX or \begin{thebibliography} should be used for the citation. + "Test if BibTeX or \\begin{thebibliography} should be used for the citation. Find the bof of the current file" (let* ((docstruct (symbol-value reftex-docstruct-symbol)) (rest (or (member (list 'bof (buffer-file-name)) docstruct) @@ -744,7 +744,7 @@ While entering the regexp, completion on knows citation keys is possible. (if (> arg 1) (progn (skip-chars-backward "}") - (decf arg) + (cl-decf arg) (reftex-do-citation arg)) (forward-char 1))) @@ -1210,7 +1210,7 @@ created files in the variables `reftex-create-bibtex-header' or ;; check for crossref entries (let* ((attr-list (reftex-parse-bibtex-entry nil beg end)) (xref-key (cdr (assoc "crossref" attr-list)))) - (if xref-key (pushnew xref-key keys))) + (if xref-key (cl-pushnew xref-key keys))) ;; check for string references (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t)) (string-fields (reftex-get-string-refs raw-fields))) @@ -1262,5 +1262,5 @@ created files in the variables `reftex-create-bibtex-header' or ;;; reftex-cite.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 58411b72fa9..16bc621f889 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function bibtex-beginning-of-entry "bibtex" ()) @@ -424,7 +424,7 @@ Calling this function several times find successive citation locations." (if match (progn (put 'reftex-view-regexp-match :props newprop) - (put 'reftex-view-regexp-match :cnt (incf cnt)) + (put 'reftex-view-regexp-match :cnt (cl-incf cnt)) (reftex-highlight 0 (match-beginning highlight-group) (match-end highlight-group)) (add-hook 'pre-command-hook 'reftex-highlight-shall-die) @@ -488,5 +488,5 @@ Calling this function several times find successive citation locations." ;;; reftex-dcr.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 8368c82373f..91d2b485626 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (provide 'reftex-global) (require 'reftex) ;;; @@ -154,7 +154,7 @@ No active TAGS table is required." (while dlist (when (and (car (car dlist)) (cdr (car dlist))) - (incf cnt) + (cl-incf cnt) (insert (mapconcat 'identity (car dlist) "\n ") "\n")) (pop dlist)) (goto-char (point-min)) @@ -223,7 +223,7 @@ one with the `xr' package." (if (assoc label translate-alist) (error "Duplicate label %s" label)) (setq new-label (concat (match-string 1 (car entry)) - (int-to-string (incf (cdr nr-cell))))) + (int-to-string (cl-incf (cdr nr-cell))))) (push (cons label new-label) translate-alist) (or (string= label new-label) (setq changed-sequence t)))) @@ -302,7 +302,7 @@ one with the `xr' package." (error "Abort"))) (reftex-unhighlight 1))) ((and test cell) - (incf n)) + (cl-incf n)) ((and (not test) cell) ;; Replace (goto-char (match-beginning 1)) @@ -477,5 +477,5 @@ With no argument, this command toggles ;;; reftex-global.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 622af95d4c5..6544029ef0c 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function texmathp "ext:texmathp" ()) (require 'reftex) @@ -128,7 +128,7 @@ will prompt for other arguments." ;; Insert the macro and ask for any additional args (insert macro) - (loop for i from 1 to nargs do + (cl-loop for i from 1 to nargs do (setq opt (member i opt-args) value (cond ((= nindex i) key) ((equal ntag i) tag1) @@ -214,16 +214,16 @@ will prompt for other arguments." i -1 val nil) (catch 'exit - (while (and (< (incf i) len) (null val)) + (while (and (< (cl-incf i) len) (null val)) (unless (assq (aref tag i) tag-alist) (push (list (aref tag i) tag (concat (substring tag 0 i) - "[" (substring tag i (incf i)) "]" + "[" (substring tag i (cl-incf i)) "]" (substring tag i))) tag-alist) (throw 'exit t))) - (push (list (+ ?0 (incf cnt)) tag + (push (list (+ ?0 (cl-incf cnt)) tag (concat "[" (int-to-string cnt) "]:" tag)) tag-alist))) (setq tag-alist (nreverse tag-alist)) @@ -287,46 +287,40 @@ will prompt for other arguments." (substitute-key-definition 'previous-line 'reftex-index-previous map global-map) - (loop for x in - '(("n" . reftex-index-next) - ("p" . reftex-index-previous) - ("?" . reftex-index-show-help) - (" " . reftex-index-view-entry) - ("\C-m" . reftex-index-goto-entry-and-hide) - ("\C-i" . reftex-index-goto-entry) - ("\C-k" . reftex-index-kill) - ("r" . reftex-index-rescan) - ("R" . reftex-index-Rescan) - ("g" . revert-buffer) - ("q" . reftex-index-quit) - ("k" . reftex-index-quit-and-kill) - ("f" . reftex-index-toggle-follow) - ("s" . reftex-index-switch-index-tag) - ("e" . reftex-index-edit) - ("^" . reftex-index-level-up) - ("_" . reftex-index-level-down) - ("}" . reftex-index-restrict-to-section) - ("{" . reftex-index-widen) - (">" . reftex-index-restriction-forward) - ("<" . reftex-index-restriction-backward) - ("(" . reftex-index-toggle-range-beginning) - (")" . reftex-index-toggle-range-end) - ("|" . reftex-index-edit-attribute) - ("@" . reftex-index-edit-visual) - ("*" . reftex-index-edit-key) - ("\C-c=". reftex-index-goto-toc) - ("c" . reftex-index-toggle-context)) - do (define-key map (car x) (cdr x))) - - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) + (define-key map "n" 'reftex-index-next) + (define-key map "p" 'reftex-index-previous) + (define-key map "?" 'reftex-index-show-help) + (define-key map " " 'reftex-index-view-entry) + (define-key map "\C-m" 'reftex-index-goto-entry-and-hide) + (define-key map "\C-i" 'reftex-index-goto-entry) + (define-key map "\C-k" 'reftex-index-kill) + (define-key map "r" 'reftex-index-rescan) + (define-key map "R" 'reftex-index-Rescan) + (define-key map "g" 'revert-buffer) + (define-key map "q" 'reftex-index-quit) + (define-key map "k" 'reftex-index-quit-and-kill) + (define-key map "f" 'reftex-index-toggle-follow) + (define-key map "s" 'reftex-index-switch-index-tag) + (define-key map "e" 'reftex-index-edit) + (define-key map "^" 'reftex-index-level-up) + (define-key map "_" 'reftex-index-level-down) + (define-key map "}" 'reftex-index-restrict-to-section) + (define-key map "{" 'reftex-index-widen) + (define-key map ">" 'reftex-index-restriction-forward) + (define-key map "<" 'reftex-index-restriction-backward) + (define-key map "(" 'reftex-index-toggle-range-beginning) + (define-key map ")" 'reftex-index-toggle-range-end) + (define-key map "|" 'reftex-index-edit-attribute) + (define-key map "@" 'reftex-index-edit-visual) + (define-key map "*" 'reftex-index-edit-key) + (define-key map "\C-c=" 'reftex-index-goto-toc) + (define-key map "c" 'reftex-index-toggle-context) ;; The capital letters and the exclamation mark - (loop for key across (concat "!" reftex-index-section-letters) do - (define-key map (vector (list key)) - (list 'lambda '() '(interactive) - (list 'reftex-index-goto-letter key)))) + (cl-loop for key across (concat "!" reftex-index-section-letters) do + (define-key map (vector (list key)) + (list 'lambda '() '(interactive) + (list 'reftex-index-goto-letter key)))) (easy-menu-define reftex-index-menu map "Menu for Index buffer" @@ -392,7 +386,7 @@ will prompt for other arguments." (defvar reftex-index-restriction-indicator nil) (defvar reftex-index-restriction-data nil) -(define-derived-mode reftex-index-mode fundamental-mode "RefTeX Index" +(define-derived-mode reftex-index-mode special-mode "RefTeX Index" "Major mode for managing Index buffers for LaTeX files. This buffer was created with RefTeX. Press `?' for a summary of important key bindings, or check the menu. @@ -1194,20 +1188,18 @@ This gets refreshed in every phrases command.") (defvar reftex-index-phrases-mode-map (let ((map (make-sparse-keymap))) ;; Keybindings and Menu for phrases buffer - (loop for x in - '(("\C-c\C-c" . reftex-index-phrases-save-and-return) - ("\C-c\C-x" . reftex-index-this-phrase) - ("\C-c\C-f" . reftex-index-next-phrase) - ("\C-c\C-r" . reftex-index-region-phrases) - ("\C-c\C-a" . reftex-index-all-phrases) - ("\C-c\C-d" . reftex-index-remaining-phrases) - ("\C-c\C-s" . reftex-index-sort-phrases) - ("\C-c\C-n" . reftex-index-new-phrase) - ("\C-c\C-m" . reftex-index-phrases-set-macro-key) - ("\C-c\C-i" . reftex-index-phrases-info) - ("\C-c\C-t" . reftex-index-find-next-conflict-phrase) - ("\C-i" . self-insert-command)) - do (define-key map (car x) (cdr x))) + (define-key map "\C-c\C-c" 'reftex-index-phrases-save-and-return) + (define-key map "\C-c\C-x" 'reftex-index-this-phrase) + (define-key map "\C-c\C-f" 'reftex-index-next-phrase) + (define-key map "\C-c\C-r" 'reftex-index-region-phrases) + (define-key map "\C-c\C-a" 'reftex-index-all-phrases) + (define-key map "\C-c\C-d" 'reftex-index-remaining-phrases) + (define-key map "\C-c\C-s" 'reftex-index-sort-phrases) + (define-key map "\C-c\C-n" 'reftex-index-new-phrase) + (define-key map "\C-c\C-m" 'reftex-index-phrases-set-macro-key) + (define-key map "\C-c\C-i" 'reftex-index-phrases-info) + (define-key map "\C-c\C-t" 'reftex-index-find-next-conflict-phrase) + (define-key map "\C-i" 'self-insert-command) (easy-menu-define reftex-index-phrases-menu map "Menu for Phrases buffer" @@ -1255,7 +1247,7 @@ This gets refreshed in every phrases command.") ["Save and Return" reftex-index-phrases-save-and-return t])) map) - "Keymap used for *toc* buffer.") + "Keymap used for index phrases buffer.") (defvar reftex-index-phrases-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\" "." table) @@ -1434,7 +1426,7 @@ Here are all local bindings. (interactive "p") (reftex-index-phrases-parse-header t) (while (> arg 0) - (decf arg) + (cl-decf arg) (end-of-line) (if (re-search-forward reftex-index-phrases-phrase-regexp12 nil t) (progn @@ -1663,11 +1655,11 @@ this function repeatedly." (widen) (goto-char (point-min)) (while (re-search-forward re1 nil t) - (incf ntimes1)) + (cl-incf ntimes1)) (goto-char (point-min)) (while (re-search-forward re2 nil t) (push (cons (count-lines 1 (point)) (match-string 1)) superphrases) - (incf ntimes2)))) + (cl-incf ntimes2)))) (save-current-buffer (while (setq file (pop files)) (setq buf (reftex-get-file-buffer-force file)) @@ -1680,7 +1672,7 @@ this function repeatedly." (let ((case-fold-search reftex-index-phrases-case-fold-search)) (while (re-search-forward re nil t) (or (reftex-in-comment) - (incf nmatches))))))))) + (cl-incf nmatches))))))))) (with-output-to-temp-buffer "*Help*" (princ (format " Phrase: %s\n" phrase)) (princ (format " Macro key: %s\n" char)) @@ -1690,7 +1682,7 @@ this function repeatedly." (index-key (let ((iks index-keys) (cnt 0) ik) (while (setq ik (pop iks)) - (princ (format "Index entry %d: %s\n" (incf cnt) ik))))) + (princ (format "Index entry %d: %s\n" (cl-incf cnt) ik))))) (repeat (princ (format " Index entry: %s\n" phrase))) (t @@ -1951,7 +1943,7 @@ both ends." (cond ((member char '(?y ?Y ?\ )) ;; Yes! (replace-match rpl t t) - (incf replace-count) + (cl-incf replace-count) ;; See if we should insert newlines to shorten lines (and reftex-index-phrases-wrap-long-lines (reftex-index-phrases-fixup-line beg end)) @@ -2119,5 +2111,5 @@ Does not do a save-excursion." ;;; reftex-index.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index bded6ed0abc..af2810d72e8 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -270,7 +270,10 @@ of master file." (when (eq (char-before) ?\\) (backward-char)) ;; Insert in List (setq toc-entry (funcall reftex-section-info-function file)) - (when toc-entry + (when (and toc-entry + (eq ;; Either both are t or both are nil. + (= (char-after bound) ?%) + (string-suffix-p ".dtx" file))) ;; It can happen that section info returns nil (setq level (nth 5 toc-entry)) (setq highest-level (min highest-level level)) @@ -306,7 +309,7 @@ of master file." (when reftex-support-index (setq index-entry (reftex-index-info file)) (when index-entry - (add-to-list 'reftex--index-tags (nth 1 index-entry)) + (cl-pushnew (nth 1 index-entry) reftex--index-tags :test #'equal) (push index-entry docstruct)))) ((match-end 11) @@ -608,7 +611,7 @@ if the information is exact (t) or approximate (nil)." found) (save-excursion (while (not rtn) - (incf cnt) + (cl-incf cnt) (setq found (re-search-backward (reftex-everything-regexp) nil t)) (setq rtn (cond @@ -672,7 +675,7 @@ if the information is exact (t) or approximate (nil)." (when (and (eq (car (car list)) 'index) (string= (nth 2 index-info) (nth 2 (car list)))) - (incf n) + (cl-incf n) (setq dist (abs (- (point) (nth 4 (car list))))) (if (or (not last-dist) (< dist last-dist)) (setq last-dist dist last (car list)))) @@ -841,8 +844,8 @@ considered an argument of macro \\macro." (let ((forward-sexp-function nil)) (backward-sexp) t) (error nil))) - (if (eq (following-char) ?\[) (incf cnt-opt)) - (incf cnt)) + (if (eq (following-char) ?\[) (cl-incf cnt-opt)) + (cl-incf cnt)) (setq pos (point)) (when (and (or (= (following-char) ?\[) (= (following-char) ?\{)) @@ -984,18 +987,18 @@ OPT-ARGS is a list of argument numbers which are optional." (while (< cnt n) (while (and (member cnt opt-args) (eq (following-char) ?\{)) - (incf cnt)) + (cl-incf cnt)) (when (< cnt n) (unless (and (condition-case nil (or (forward-list 1) t) (error nil)) (reftex-move-to-next-arg) - (incf cnt)) + (cl-incf cnt)) (setq cnt 1000)))) (while (and (memq cnt opt-args) (eq (following-char) ?\{)) - (incf cnt))) + (cl-incf cnt))) (if (and (= n cnt) (> (skip-chars-forward "{\\[") 0)) (reftex-context-substring) @@ -1057,7 +1060,7 @@ When point is just after a { or [, limit string to matching parenthesis" (- (string-to-char number-string) ?A -1)) (aset reftex-section-numbers i (string-to-number number-string))) (pop numbers)) - (decf i))) + (cl-decf i))) (put 'reftex-section-numbers 'appendix appendix)) ;;;###autoload @@ -1081,7 +1084,7 @@ When LEVEL is non-nil, increase section numbers on that level." (if (or (not partspecial) (not (= idx 1))) (aset reftex-section-numbers idx 0)) - (incf idx)))) + (cl-incf idx)))) (if partspecial (setq string (concat "Part " (reftex-roman-number (aref reftex-section-numbers 0)))) @@ -1091,7 +1094,7 @@ When LEVEL is non-nil, increase section numbers on that level." (if (not (and partspecial (not (equal string "")))) (setq string (concat string (if (not (string= string "")) "." "") (int-to-string n)))) - (incf idx)) + (cl-incf idx)) (save-match-data (if (string-match "\\`\\([@0]\\.\\)+" string) (setq string (replace-match "" nil nil string))) @@ -1131,5 +1134,5 @@ When LEVEL is non-nil, increase section numbers on that level." ;;; reftex-parse.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 5f48cac0b49..dd183548d0f 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) (require 'reftex-parse) @@ -374,7 +374,7 @@ also applies `reftex-translate-to-ascii-function' to the string." (sep (or separator ""))) (while (assoc (concat label sep (int-to-string num)) (symbol-value reftex-docstruct-symbol)) - (incf num)) + (cl-incf num)) (setcdr cell num) (concat label sep (int-to-string num)))))) @@ -566,7 +566,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (reftex-erase-buffer)) (unless (eq major-mode 'reftex-select-label-mode) (reftex-select-label-mode)) - (add-to-list 'selection-buffers (current-buffer)) + (cl-pushnew (current-buffer) selection-buffers) (setq truncate-lines t) (setq mode-line-format (list "---- " 'mode-line-buffer-identification @@ -881,5 +881,5 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." ;;; reftex-ref.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 247a5b18f29..a4533adec08 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -32,6 +32,7 @@ ;; and reftex-select-bib-mode-map. (defvar reftex-select-shared-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) (substitute-key-definition 'next-line 'reftex-select-next map global-map) (substitute-key-definition @@ -41,31 +42,23 @@ (substitute-key-definition 'newline 'reftex-select-accept map global-map) - (loop for x in - '((" " . reftex-select-callback) - ("n" . reftex-select-next) - ([(down)] . reftex-select-next) - ("p" . reftex-select-previous) - ([(up)] . reftex-select-previous) - ("f" . reftex-select-toggle-follow) - ("\C-m" . reftex-select-accept) - ([(return)] . reftex-select-accept) - ("q" . reftex-select-quit) - ("." . reftex-select-show-insertion-point) - ("?" . reftex-select-help)) - do (define-key map (car x) (cdr x))) + (define-key map " " 'reftex-select-callback) + (define-key map "n" 'reftex-select-next) + (define-key map [(down)] 'reftex-select-next) + (define-key map "p" 'reftex-select-previous) + (define-key map [(up)] 'reftex-select-previous) + (define-key map "f" 'reftex-select-toggle-follow) + (define-key map "\C-m" 'reftex-select-accept) + (define-key map [(return)] 'reftex-select-accept) + (define-key map "q" 'reftex-select-quit) + (define-key map "." 'reftex-select-show-insertion-point) + (define-key map "?" 'reftex-select-help) ;; The mouse-2 binding (if (featurep 'xemacs) (define-key map [(button2)] 'reftex-select-mouse-accept) (define-key map [(mouse-2)] 'reftex-select-mouse-accept) (define-key map [follow-link] 'mouse-face)) - - - ;; Digit arguments - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) map)) (define-obsolete-variable-alias @@ -74,28 +67,25 @@ (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) - (loop for key across "aAcgFlrRstx#%" do - (define-key map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) - - (loop for x in - '(("b" . reftex-select-jump-to-previous) - ("z" . reftex-select-jump) - ("v" . reftex-select-cycle-ref-style-forward) - ("V" . reftex-select-cycle-ref-style-backward) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark) - ("," . reftex-select-mark-comma) - ("-" . reftex-select-mark-to) - ("+" . reftex-select-mark-and) - ([(tab)] . reftex-select-read-label) - ("\C-i" . reftex-select-read-label) - ("\C-c\C-n" . reftex-select-next-heading) - ("\C-c\C-p" . reftex-select-previous-heading)) - do - (define-key map (car x) (cdr x))) + (cl-loop for key across "aAcgFlrRstx#%" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) + + (define-key map "b" 'reftex-select-jump-to-previous) + (define-key map "z" 'reftex-select-jump) + (define-key map "v" 'reftex-select-cycle-ref-style-forward) + (define-key map "V" 'reftex-select-cycle-ref-style-backward) + (define-key map "m" 'reftex-select-mark) + (define-key map "u" 'reftex-select-unmark) + (define-key map "," 'reftex-select-mark-comma) + (define-key map "-" 'reftex-select-mark-to) + (define-key map "+" 'reftex-select-mark-and) + (define-key map [(tab)] 'reftex-select-read-label) + (define-key map "\C-i" 'reftex-select-read-label) + (define-key map "\C-c\C-n" 'reftex-select-next-heading) + (define-key map "\C-c\C-p" 'reftex-select-previous-heading) map) "Keymap used for *RefTeX Select* buffer, when selecting a label. @@ -130,18 +120,16 @@ During a selection process, these are the local bindings. (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) - (loop for key across "grRaAeE" do - (define-key map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) + (cl-loop for key across "grRaAeE" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) - (loop for x in - '(("\C-i" . reftex-select-read-cite) - ([(tab)] . reftex-select-read-cite) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark)) - do (define-key map (car x) (cdr x))) + (define-key map "\C-i" 'reftex-select-read-cite) + (define-key map [(tab)] 'reftex-select-read-cite) + (define-key map "m" 'reftex-select-mark) + (define-key map "u" 'reftex-select-unmark) map) "Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry. @@ -272,7 +260,7 @@ During a selection process, these are the local bindings. ;; Walk the docstruct and insert the appropriate stuff (while (setq cell (pop all)) - (incf index) + (cl-incf index) (setq from (point)) (cond @@ -342,7 +330,7 @@ During a selection process, these are the local bindings. (or show-commented (null comment))) ;; Yes we want this one - (incf cnt) + (cl-incf cnt) (setq prev-inserted cell) ; (if (eq offset 'attention) (setq offset cell)) @@ -728,8 +716,8 @@ Cycle in reverse order if optional argument REVERSE is non-nil." (setq sep (nth 2 c)) (reftex-overlay-put (nth 1 c) 'before-string (if sep - (format "*%c%d* " sep (decf cnt)) - (format "*%d* " (decf cnt))))) + (format "*%c%d* " sep (cl-decf cnt)) + (format "*%d* " (cl-decf cnt))))) reftex-select-marked) (message "Entry no longer marked"))) @@ -745,5 +733,5 @@ Cycle in reverse order if optional argument REVERSE is non-nil." ;;; reftex-sel.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index b66a081c941..4f7c738a134 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -24,7 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (provide 'reftex-toc) (require 'reftex) ;;; @@ -42,41 +41,34 @@ (substitute-key-definition 'previous-line 'reftex-toc-previous map global-map) - (loop for x in - '(("n" . reftex-toc-next) - ("p" . reftex-toc-previous) - ("?" . reftex-toc-show-help) - (" " . reftex-toc-view-line) - ("\C-m" . reftex-toc-goto-line-and-hide) - ("\C-i" . reftex-toc-goto-line) - ("\C-c>" . reftex-toc-display-index) - ("r" . reftex-toc-rescan) - ("R" . reftex-toc-Rescan) - ("g" . revert-buffer) - ("q" . reftex-toc-quit) ; - ("k" . reftex-toc-quit-and-kill) - ("f" . reftex-toc-toggle-follow) ; - ("a" . reftex-toggle-auto-toc-recenter) - ("d" . reftex-toc-toggle-dedicated-frame) - ("F" . reftex-toc-toggle-file-boundary) - ("i" . reftex-toc-toggle-index) - ("l" . reftex-toc-toggle-labels) - ("t" . reftex-toc-max-level) - ("c" . reftex-toc-toggle-context) - ;; ("%" . reftex-toc-toggle-commented) - ("\M-%" . reftex-toc-rename-label) - ("x" . reftex-toc-external) - ("z" . reftex-toc-jump) - ("." . reftex-toc-show-calling-point) - ("\C-c\C-n" . reftex-toc-next-heading) - ("\C-c\C-p" . reftex-toc-previous-heading) - (">" . reftex-toc-demote) - ("<" . reftex-toc-promote)) - do (define-key map (car x) (cdr x))) - - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) + (define-key map "n" 'reftex-toc-next) + (define-key map "p" 'reftex-toc-previous) + (define-key map "?" 'reftex-toc-show-help) + (define-key map " " 'reftex-toc-view-line) + (define-key map "\C-m" 'reftex-toc-goto-line-and-hide) + (define-key map "\C-i" 'reftex-toc-goto-line) + (define-key map "\C-c>" 'reftex-toc-display-index) + (define-key map "r" 'reftex-toc-rescan) + (define-key map "R" 'reftex-toc-Rescan) + (define-key map "q" 'reftex-toc-quit) ; + (define-key map "k" 'reftex-toc-quit-and-kill) + (define-key map "f" 'reftex-toc-toggle-follow) ; + (define-key map "a" 'reftex-toggle-auto-toc-recenter) + (define-key map "d" 'reftex-toc-toggle-dedicated-frame) + (define-key map "F" 'reftex-toc-toggle-file-boundary) + (define-key map "i" 'reftex-toc-toggle-index) + (define-key map "l" 'reftex-toc-toggle-labels) + (define-key map "t" 'reftex-toc-max-level) + (define-key map "c" 'reftex-toc-toggle-context) + ;; (define-key map "%" 'reftex-toc-toggle-commented) + (define-key map "\M-%" 'reftex-toc-rename-label) + (define-key map "x" 'reftex-toc-external) + (define-key map "z" 'reftex-toc-jump) + (define-key map "." 'reftex-toc-show-calling-point) + (define-key map "\C-c\C-n" 'reftex-toc-next-heading) + (define-key map "\C-c\C-p" 'reftex-toc-previous-heading) + (define-key map ">" 'reftex-toc-demote) + (define-key map "<" 'reftex-toc-promote) (easy-menu-define reftex-toc-menu map @@ -388,13 +380,17 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (defun reftex-re-enlarge () "Enlarge window to a remembered size." + ;; FIXME: reftex-last-window-width might be the width of another window on + ;; another frame, so the enlarge-window call might make no sense. + ;; We should just use `quit-window' instead nowadays. (let ((count (if reftex-toc-split-windows-horizontally (- (or reftex-last-window-width (window-total-width)) (window-total-width)) (- (or reftex-last-window-height (window-height)) (window-height))))) (when (> count 0) - (enlarge-window count reftex-toc-split-windows-horizontally)))) + (with-demoted-errors ;E.g. the window might be the root window! + (enlarge-window count reftex-toc-split-windows-horizontally))))) (defun reftex-toc-dframe-p (&optional frame error) ;; Check if FRAME is the dedicated TOC frame. @@ -942,17 +938,17 @@ label prefix determines the wording of a reference." (with-selected-window toc-window (reftex-unhighlight 0))) ((eq final 'hide) - (let ((show-window (selected-window)) - (show-buffer (window-buffer))) - (unless (eq show-window toc-window) ;FIXME: Can this happen? + (let ((window (selected-window)) + (buffer (window-buffer))) + (unless (eq window toc-window) ;FIXME: Can this happen? (with-selected-window toc-window (reftex-unhighlight 0) (or (one-window-p) (delete-window)))) - ;; If `show-window' is still live, show-buffer is already visible + ;; If window is still live, buffer is already visible ;; so let's not make it visible in yet-another-window. - (unless (window-live-p show-window) - ;; FIXME: How could show-window not be live? - (switch-to-buffer show-buffer)) + (unless (window-live-p window) + ;; FIXME: How could window not be live? + (pop-to-buffer-same-window buffer)) (reftex-re-enlarge))) (t (unless (eq (selected-frame) (window-frame toc-window)) @@ -1111,5 +1107,5 @@ always show the current section in connection with the option ;;; reftex-toc.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 2aac0cff5f3..03da584e96f 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -24,7 +24,7 @@ ;;; Code: (defvar reftex-tables-dirty) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (eval-and-compile (defun reftex-set-dirty (symbol value) (setq reftex-tables-dirty t) @@ -151,6 +151,24 @@ distribution. Mixed-case symbols are convenience aliases.") (?A . "\\citeauthor*{%l}") (?y . "\\citeyear{%l}") (?n . "\\nocite{%l}"))) + (biblatex "The Biblatex package" + ((?\C-m . "\\cite[][]{%l}") + (?C . "\\cite*[][]{%l}") + (?t . "\\textcite[][]{%l}") + (?T . "\\textcite*[][]{%l}") + (?p . "\\parencite[][]{%l}") + (?P . "\\parencite*[][]{%l}") + (?f . "\\footcite[][]{%l}") + (?s . "\\smartcite[][]{%l}") + (?u . "\\autocite[][]{%l}") + (?U . "\\autocite*[][]{%l}") + (?a . "\\citeauthor{%l}") + (?A . "\\citeauthor*{%l}") + (?i . "\\citetitle{%l}") + (?I . "\\citetitle*{%l}") + (?y . "\\citeyear{%l}") + (?Y . "\\citeyear*{%l}") + (?n . "\\nocite{%l}"))) (amsrefs "The AMSRefs package" ((?\C-m . "\\cite{%l}") (?p . "\\cite{%l}") @@ -1076,9 +1094,9 @@ used in the variable `reftex-ref-style-alist'." ;; Compatibility with obsolete variables. (when reftex-vref-is-default - (add-to-list 'reftex-ref-style-default-list "Varioref")) + (cl-pushnew "Varioref" reftex-ref-style-default-list :test #'equal)) (when reftex-fref-is-default - (add-to-list 'reftex-ref-style-default-list "Fancyref")) + (cl-pushnew "Fancyref" reftex-ref-style-default-list :test #'equal)) (defcustom reftex-level-indent 2 "Number of spaces to be used for indentation per section level." diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 5437881e2e9..9754d2b20ff 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -50,7 +50,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Stuff that needs to be there when we use defcustom (require 'custom) @@ -70,7 +70,8 @@ (require 'reftex-vars) -;;; Autoloads - see end for automatic autoloads +;;; Autoloads to ensure loading of support files when necessary +(require 'reftex-loaddefs) ;; We autoload tons of functions from these files, but some have ;; a single function that needs to be globally autoloaded. @@ -99,7 +100,42 @@ (defconst reftex-version emacs-version "Version string for RefTeX.") -(defvar reftex-mode-map (make-sparse-keymap) +(defvar reftex-mode-map + (let ((map (make-sparse-keymap))) + ;; The default bindings in the mode map. + (define-key map "\C-c=" 'reftex-toc) + (define-key map "\C-c-" 'reftex-toc-recenter) + (define-key map "\C-c(" 'reftex-label) + (define-key map "\C-c)" 'reftex-reference) + (define-key map "\C-c[" 'reftex-citation) + (define-key map "\C-c<" 'reftex-index) + (define-key map "\C-c>" 'reftex-display-index) + (define-key map "\C-c/" 'reftex-index-selection-or-word) + (define-key map "\C-c\\" 'reftex-index-phrase-selection-or-word) + (define-key map "\C-c|" 'reftex-index-visit-phrases-buffer) + (define-key map "\C-c&" 'reftex-view-crossref) + + ;; Bind `reftex-mouse-view-crossref' only when the key is still free + (if (featurep 'xemacs) + (unless (key-binding [(shift button2)]) + (define-key map [(shift button2)] 'reftex-mouse-view-crossref)) + (unless (key-binding [(shift mouse-2)]) + (define-key map [(shift mouse-2)] 'reftex-mouse-view-crossref))) + + ;; For most of these commands there are already bindings in place. + ;; Setting `reftex-extra-bindings' really is only there to spare users + ;; the hassle of defining bindings in the user space themselves. This + ;; is why they violate the key binding recommendations. + (when reftex-extra-bindings + (define-key map "\C-ct" 'reftex-toc) + (define-key map "\C-cl" 'reftex-label) + (define-key map "\C-cr" 'reftex-reference) + (define-key map "\C-cc" 'reftex-citation) + (define-key map "\C-cv" 'reftex-view-crossref) + (define-key map "\C-cg" 'reftex-grep-document) + (define-key map "\C-cs" 'reftex-search-document)) + + map) "Keymap for RefTeX mode.") (defvar reftex-mode-menu nil) @@ -254,7 +290,7 @@ on the menu bar. (defun reftex-next-multifile-index () ;; Return the next free index for multifile symbols. - (incf reftex-multifile-index)) + (cl-incf reftex-multifile-index)) (defun reftex-tie-multifile-symbols () "Tie the buffer-local symbols to globals connected with the master file. @@ -316,7 +352,7 @@ If the symbols for the current master file do not exist, they are created." ((save-excursion (goto-char (point-min)) (re-search-forward - "^[[:space:]]*\\\\documentclass\\[\\([[:word:].]+\\)\\]{subfiles}" + "^[[:space:]]*\\\\documentclass\\[\\([^]]+\\)\\]{subfiles}" nil t)) (match-string-no-properties 1)) ;; AUCTeX is loaded. Use its mechanism. @@ -443,7 +479,7 @@ will deactivate it." (unless (member style list) (setq reftex-tables-dirty t changed t) - (add-to-list 'list style t))) + (setq list (append list (list style))))) ((eq action 'deactivate) (when (member style list) (setq reftex-tables-dirty t @@ -452,7 +488,7 @@ will deactivate it." (t (if (member style list) (delete style list) - (add-to-list 'list style t)) + (setq list (append list (list style)))) (setq reftex-tables-dirty t changed t))) (when changed @@ -658,9 +694,9 @@ on next use." (interactive) ;; Reset the file search path variables - (loop for prop in '(status master-dir recursive-path rec-type) do - (put 'reftex-tex-path prop nil) - (put 'reftex-bib-path prop nil)) + (dolist (prop '(status master-dir recursive-path rec-type)) + (put 'reftex-tex-path prop nil) + (put 'reftex-bib-path prop nil)) ;; Kill temporary buffers associated with RefTeX - just in case they ;; were not cleaned up properly @@ -795,15 +831,15 @@ This enforces rescanning the buffer on next use." reffmt (nth 1 fmt)) ;; Note a new typekey (if typekey - (add-to-list 'reftex-typekey-list typekey)) + (cl-pushnew typekey reftex-typekey-list :test #'equal)) (if (and typekey prefix (not (assoc prefix reftex-prefix-to-typekey-alist))) - (add-to-list 'reftex-prefix-to-typekey-alist - (cons prefix typekey))) + (cl-pushnew (cons prefix typekey) reftex-prefix-to-typekey-alist + :test #'equal)) (if (and typekey prefix (not (assoc typekey reftex-typekey-to-prefix-alist))) - (add-to-list 'reftex-typekey-to-prefix-alist - (cons typekey prefix))) + (cl-pushnew (cons typekey prefix) reftex-typekey-to-prefix-alist + :test #'equal)) ;; Check if this is a macro or environment (cond ((symbolp env-or-mac) @@ -812,17 +848,17 @@ This enforces rescanning the buffer on next use." (message "Warning: %s does not seem to be a valid function" env-or-mac)) (setq nargs nil nlabel nil opt-args nil) - (add-to-list 'reftex-special-env-parsers env-or-mac) + (cl-pushnew env-or-mac reftex-special-env-parsers) (setq env-or-mac (symbol-name env-or-mac))) ((string-match "\\`\\\\" env-or-mac) ;; It's a macro (let ((result (reftex-parse-args env-or-mac))) - (setq env-or-mac (or (first result) env-or-mac) - nargs (second result) - nlabel (third result) - opt-args (fourth result)) - (if nlabel (add-to-list 'macros-with-labels env-or-mac))) - (if typekey (add-to-list 'reftex-label-mac-list env-or-mac))) + (setq env-or-mac (or (cl-first result) env-or-mac) + nargs (cl-second result) + nlabel (cl-third result) + opt-args (cl-fourth result)) + (if nlabel (cl-pushnew env-or-mac macros-with-labels :test #'equal))) + (if typekey (cl-pushnew env-or-mac reftex-label-mac-list :test #'equal))) (t ;; It's an environment (setq nargs nil nlabel nil opt-args nil) @@ -830,7 +866,7 @@ This enforces rescanning the buffer on next use." ((string= env-or-mac "")) ((string= env-or-mac "section")) (t - (add-to-list 'reftex-label-env-list env-or-mac) + (cl-pushnew env-or-mac reftex-label-env-list :test #'equal) (if toc-level (let ((string (format "begin{%s}" env-or-mac))) (or (assoc string toc-levels) @@ -914,7 +950,7 @@ This enforces rescanning the buffer on next use." (not (member (aref fmt i) '(?%)))) (setq word (concat word "\\|" (regexp-quote (substring fmt 0 (1+ i))))) - (incf i)) + (cl-incf i)) (cons (concat word "\\)\\=") typekey)) (nreverse reftex-words-to-typekey-alist))) @@ -940,10 +976,10 @@ This enforces rescanning the buffer on next use." (t t)) all-index (cdr all-index)) (let ((result (reftex-parse-args macro))) - (setq macro (or (first result) macro) - nargs (second result) - nindex (third result) - opt-args (fourth result)) + (setq macro (or (cl-first result) macro) + nargs (cl-second result) + nindex (cl-third result) + opt-args (cl-fourth result)) (unless (member macro reftex-macros-with-index) ;; 0 1 2 3 4 5 6 7 (push (list macro tag prefix verify nargs nindex opt-args repeat) @@ -967,7 +1003,7 @@ This enforces rescanning the buffer on next use." (mapconcat (lambda(x) (format "[%c] %-20.20s%s" (car x) (nth 1 x) - (if (= 0 (mod (incf i) 3)) "\n" ""))) + (if (= 0 (mod (cl-incf i) 3)) "\n" ""))) reftex-key-to-index-macro-alist ""))) ;; Make the full list of section levels @@ -979,8 +1015,8 @@ This enforces rescanning the buffer on next use." ;; Calculate the regular expressions (let* ( ; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") - (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because - ; match numbers are hard coded + (wbol "\\(^\\)%?[ \t]*") ; Need to keep the empty group because + ; match numbers are hard coded (label-re (concat "\\(?:" (mapconcat 'identity reftex-label-regexps "\\|") "\\)")) @@ -1057,7 +1093,7 @@ This enforces rescanning the buffer on next use." (args (substring macro (match-beginning 0))) opt-list nlabel (cnt 0)) (while (string-match "\\`[[{]\\(\\*\\)?[]}]" args) - (incf cnt) + (cl-incf cnt) (when (eq ?\[ (string-to-char args)) (push cnt opt-list)) (when (and (match-end 1) @@ -1122,7 +1158,7 @@ This enforces rescanning the buffer on next use." (defun reftex-silence-toc-markers (list n) ;; Set all toc markers in the first N entries in list to nil - (while (and list (> (decf n) -1)) + (while (and list (> (cl-decf n) -1)) (and (eq (car (car list)) 'toc) (markerp (nth 4 (car list))) (set-marker (nth 4 (car list)) nil)) @@ -1253,7 +1289,7 @@ Valid actions are: readable, restore, read, kill, write." "SELECT EXTERNAL DOCUMENT\n------------------------\n" (mapconcat (lambda (x) - (format fmt (incf n) (or (car x) "") + (format fmt (cl-incf n) (or (car x) "") (abbreviate-file-name (cdr x)))) xr-alist "")) nil t)) @@ -1757,11 +1793,11 @@ When DIE is non-nil, throw an error if file not found." ;; with limited Magic ;; The magic goes away - (letf ((format-alist nil) - (auto-mode-alist (reftex-auto-mode-alist)) - ((default-value 'major-mode) 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil)) + (cl-letf ((format-alist nil) + (auto-mode-alist (reftex-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil)) (setq buf (find-file-noselect file))) ;; Is there a hook to run? @@ -1771,7 +1807,7 @@ When DIE is non-nil, throw an error if file not found." ;; Let's see if we got a license to kill :-| (and mark-to-kill - (add-to-list 'reftex-buffers-to-kill buf)) + (cl-pushnew buf reftex-buffers-to-kill)) ;; Return the new buffer buf) @@ -2133,30 +2169,6 @@ IGNORE-WORDS List of words which should be removed from the string." ;;; ;;; Keybindings -;; The default bindings in the mode map. -(loop for x in - '(("\C-c=" . reftex-toc) - ("\C-c-" . reftex-toc-recenter) - ("\C-c(" . reftex-label) - ("\C-c)" . reftex-reference) - ("\C-c[" . reftex-citation) - ("\C-c<" . reftex-index) - ("\C-c>" . reftex-display-index) - ("\C-c/" . reftex-index-selection-or-word) - ("\C-c\\" . reftex-index-phrase-selection-or-word) - ("\C-c|" . reftex-index-visit-phrases-buffer) - ("\C-c&" . reftex-view-crossref)) - do (define-key reftex-mode-map (car x) (cdr x))) - -;; Bind `reftex-mouse-view-crossref' only when the key is still free -(if (featurep 'xemacs) - (unless (key-binding [(shift button2)]) - (define-key reftex-mode-map [(shift button2)] - 'reftex-mouse-view-crossref)) - (unless (key-binding [(shift mouse-2)]) - (define-key reftex-mode-map [(shift mouse-2)] - 'reftex-mouse-view-crossref))) - (defvar bibtex-mode-map) ;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map @@ -2164,21 +2176,6 @@ IGNORE-WORDS List of words which should be removed from the string." "bibtex" '(define-key bibtex-mode-map "\C-c&" 'reftex-view-crossref-from-bibtex)) -;; For most of these commands there are already bindings in place. -;; Setting `reftex-extra-bindings' really is only there to spare users -;; the hassle of defining bindings in the user space themselves. This -;; is why they violate the key binding recommendations. -(when reftex-extra-bindings - (loop for x in - '(("\C-ct" . reftex-toc) - ("\C-cl" . reftex-label) - ("\C-cr" . reftex-reference) - ("\C-cc" . reftex-citation) - ("\C-cv" . reftex-view-crossref) - ("\C-cg" . reftex-grep-document) - ("\C-cs" . reftex-search-document)) - do (define-key reftex-mode-map (car x) (cdr x)))) - ;;; ========================================================================= ;;; ;;; Menu @@ -2268,7 +2265,7 @@ IGNORE-WORDS List of words which should be removed from the string." :style 'toggle :selected `(member ,elt (reftex-ref-style-list)))) (unless (member item list) - (add-to-list 'list item t))) + (setq list (append list (list item))))) list)) ("Citation Style" ,@(mapcar @@ -2394,702 +2391,6 @@ Your bug report will be posted to the AUCTeX bug reporting list. (setq reftex-tables-dirty t) ; in case this file is evaluated by hand - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "reftex-auc" "reftex-auc.el" "afa9d79b344b5c24497ae5dfa9c93c42") -;;; Generated autoloads from reftex-auc.el - -(autoload 'reftex-arg-label "reftex-auc" "\ -Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. -What is being used depends upon `reftex-plug-into-AUCTeX'. - -\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) - -(autoload 'reftex-arg-cite "reftex-auc" "\ -Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. -What is being used depends upon `reftex-plug-into-AUCTeX'. - -\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) - -(autoload 'reftex-arg-index-tag "reftex-auc" "\ -Prompt for an index tag with completion. -This is the name of an index, not the entry. - -\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) - -(autoload 'reftex-arg-index "reftex-auc" "\ -Prompt for an index entry completing with known entries. -Completion is specific for just one index, if the macro or a tag -argument identify one of multiple indices. - -\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) - -(autoload 'reftex-plug-into-AUCTeX "reftex-auc" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" "\ -Toggle Interface between AUCTeX and RefTeX on and off. - -\(fn)" t nil) - -(autoload 'reftex-add-label-environments "reftex-auc" "\ -Add label environment descriptions to `reftex-label-alist-style'. -The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there -for details. -This function makes it possible to support RefTeX from AUCTeX style files. -The entries in ENTRY-LIST will be processed after the user settings in -`reftex-label-alist', and before the defaults (specified in -`reftex-default-label-alist-entries'). Any changes made to -`reftex-label-alist-style' will raise a flag to the effect that -the label information is recompiled on next use. - -\(fn ENTRY-LIST)" nil nil) - -(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) - -(autoload 'reftex-add-section-levels "reftex-auc" "\ -Add entries to the value of `reftex-section-levels'. -The added values are kept local to the current document. The format -of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See -`reftex-section-levels' for an example. - -\(fn ENTRY-LIST)" nil nil) - -(autoload 'reftex-notice-new-section "reftex-auc" "\ - - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-cite" "reftex-cite.el" "3551569ca138ec69e6759cd26f8e529d") -;;; Generated autoloads from reftex-cite.el - -(autoload 'reftex-default-bibliography "reftex-cite" "\ -Return the expanded value of variable `reftex-default-bibliography'. -The expanded value is cached. - -\(fn)" nil nil) - -(autoload 'reftex-bib-or-thebib "reftex-cite" "\ -Test if BibTeX or egin{thebibliography} should be used for the citation. -Find the bof of the current file - -\(fn)" nil nil) - -(autoload 'reftex-get-bibfile-list "reftex-cite" "\ -Return list of bibfiles for current document. -When using the chapterbib or bibunits package you should either -use the same database files everywhere, or separate parts using -different databases into different files (included into the mater file). -Then this function will return the applicable database files. - -\(fn)" nil nil) - -(autoload 'reftex-pop-to-bibtex-entry "reftex-cite" "\ -Find BibTeX KEY in any file in FILE-LIST in another window. -If MARK-TO-KILL is non-nil, mark new buffer to kill. -If HIGHLIGHT is non-nil, highlight the match. -If ITEM in non-nil, search for bibitem instead of database entry. -If RETURN is non-nil, just return the entry and restore point. - -\(fn KEY FILE-LIST &optional MARK-TO-KILL HIGHLIGHT ITEM RETURN)" nil nil) - -(autoload 'reftex-end-of-bib-entry "reftex-cite" "\ - - -\(fn ITEM)" nil nil) - -(autoload 'reftex-parse-bibtex-entry "reftex-cite" "\ -Parse BibTeX ENTRY. -If ENTRY is nil then parse the entry in current buffer between FROM and TO. -If RAW is non-nil, keep double quotes/curly braces delimiting fields. - -\(fn ENTRY &optional FROM TO RAW)" nil nil) - -(autoload 'reftex-citation "reftex-cite" "\ -Make a citation using BibTeX database files. -After prompting for a regular expression, scans the buffers with -bibtex entries (taken from the \\bibliography command) and offers the -matching entries for selection. The selected entry is formatted according -to `reftex-cite-format' and inserted into the buffer. - -If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. - -FORMAT-KEY can be used to pre-select a citation format. - -When called with a `C-u' prefix, prompt for optional arguments in -cite macros. When called with a numeric prefix, make that many -citations. When called with point inside the braces of a `\\cite' -command, it will add another key, ignoring the value of -`reftex-cite-format'. - -The regular expression uses an expanded syntax: && is interpreted as `and'. -Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. -While entering the regexp, completion on knows citation keys is possible. -`=' is a good regular expression to match all entries in all files. - -\(fn &optional NO-INSERT FORMAT-KEY)" t nil) - -(autoload 'reftex-citep "reftex-cite" "\ -Call `reftex-citation' with a format selector `?p'. - -\(fn)" t nil) - -(autoload 'reftex-citet "reftex-cite" "\ -Call `reftex-citation' with a format selector `?t'. - -\(fn)" t nil) - -(autoload 'reftex-make-cite-echo-string "reftex-cite" "\ -Format a bibtex ENTRY for the echo area and cache the result. - -\(fn ENTRY DOCSTRUCT-SYMBOL)" nil nil) - -(autoload 'reftex-create-bibtex-file "reftex-cite" "\ -Create a new BibTeX database BIBFILE with all entries referenced in document. -The command prompts for a filename and writes the collected -entries to that file. Only entries referenced in the current -document with any \\cite-like macros are used. The sequence in -the new file is the same as it was in the old database. - -Entries referenced from other entries must appear after all -referencing entries. - -You can define strings to be used as header or footer for the -created files in the variables `reftex-create-bibtex-header' or -`reftex-create-bibtex-footer' respectively. - -\(fn BIBFILE)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-dcr" "reftex-dcr.el" "ed2b6bd7485f1d0c36c76e40b5493bf0") -;;; Generated autoloads from reftex-dcr.el - -(autoload 'reftex-view-crossref "reftex-dcr" "\ -View cross reference of macro at point. Point must be on the KEY -argument. When at a `\\ref' macro, show corresponding `\\label' -definition, also in external documents (`xr'). When on a label, show -a locations where KEY is referenced. Subsequent calls find additional -locations. When on a `\\cite', show the associated `\\bibitem' macro or -the BibTeX database entry. When on a `\\bibitem', show a `\\cite' macro -which uses this KEY. When on an `\\index', show other locations marked -by the same index entry. -To define additional cross referencing items, use the option -`reftex-view-crossref-extra'. See also `reftex-view-crossref-from-bibtex'. -With one or two C-u prefixes, enforce rescanning of the document. -With argument 2, select the window showing the cross reference. -AUTO-HOW is only for the automatic crossref display and is handed through -to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'. - -\(fn &optional ARG AUTO-HOW FAIL-QUIETLY)" t nil) - -(autoload 'reftex-mouse-view-crossref "reftex-dcr" "\ -View cross reference of \\ref or \\cite macro where you click. -If the macro at point is a \\ref, show the corresponding label definition. -If it is a \\cite, show the BibTeX database entry. -If there is no such macro at point, search forward to find one. -With argument, actually select the window showing the cross reference. - -\(fn EV)" t nil) - -(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr" "\ -Toggle the automatic display of crossref information in the echo area. -When active, leaving point idle in the argument of a \\ref or \\cite macro -will display info in the echo area. - -\(fn)" t nil) - -(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "\ -View location in a LaTeX document which cites the BibTeX entry at point. -Since BibTeX files can be used by many LaTeX documents, this function -prompts upon first use for a buffer in RefTeX mode. To reset this -link to a document, call the function with a prefix arg. -Calling this function several times find successive citation locations. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-global" "reftex-global.el" "cc21fc5ee6275154dd57e24b0f5e643b") -;;; Generated autoloads from reftex-global.el - -(autoload 'reftex-create-tags-file "reftex-global" "\ -Create TAGS file by running `etags' on the current document. -The TAGS file is also immediately visited with `visit-tags-table'. - -\(fn)" t nil) - -(autoload 'reftex-grep-document "reftex-global" "\ -Run grep query through all files related to this document. -With prefix arg, force to rescan document. -No active TAGS table is required. - -\(fn GREP-CMD)" t nil) - -(autoload 'reftex-search-document "reftex-global" "\ -Regexp search through all files of the current document. -Starts always in the master file. Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. -No active TAGS table is required. - -\(fn &optional REGEXP)" t nil) - -(autoload 'reftex-query-replace-document "reftex-global" "\ -Do `query-replace-regexp' of FROM with TO over the entire document. -Third arg DELIMITED (prefix arg) means replace only word-delimited matches. -If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]. -No active TAGS table is required. - -\(fn &optional FROM TO DELIMITED)" t nil) - -(autoload 'reftex-find-duplicate-labels "reftex-global" "\ -Produce a list of all duplicate labels in the document. - -\(fn)" t nil) - -(autoload 'reftex-change-label "reftex-global" "\ -Run `query-replace-regexp' of FROM with TO in all macro arguments. -Works on the entire multifile document. -If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]. -No active TAGS table is required. - -\(fn &optional FROM TO)" t nil) - -(autoload 'reftex-renumber-simple-labels "reftex-global" "\ -Renumber all simple labels in the document to make them sequentially. -Simple labels are the ones created by RefTeX, consisting only of the -prefix and a number. After the command completes, all these labels will -have sequential numbers throughout the document. Any references to -the labels will be changed as well. For this, RefTeX looks at the -arguments of any macros which either start or end in the string `ref'. -This command should be used with care, in particular in multifile -documents. You should not use it if another document refers to this -one with the `xr' package. - -\(fn)" t nil) - -(autoload 'reftex-save-all-document-buffers "reftex-global" "\ -Save all documents associated with the current document. -The function is useful after a global action like replacing or renumbering -labels. - -\(fn)" t nil) - -(autoload 'reftex-isearch-minor-mode "reftex-global" "\ -When on, isearch searches the whole document, not only the current file. -This minor mode allows isearch to search through all the files of -the current TeX document. - -With no argument, this command toggles -`reftex-isearch-minor-mode'. With a prefix argument ARG, turn -`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-index" "reftex-index.el" "a3e1ce5ba2b769a6a3a8f3a60ac87397") -;;; Generated autoloads from reftex-index.el - -(autoload 'reftex-index-selection-or-word "reftex-index" "\ -Put selection or the word near point into the default index macro. -This uses the information in `reftex-index-default-macro' to make an index -entry. The phrase indexed is the current selection or the word near point. -When called with one `C-u' prefix, let the user have a chance to edit the -index entry. When called with 2 `C-u' as prefix, also ask for the index -macro and other stuff. -When called inside TeX math mode as determined by the `texmathp.el' library -which is part of AUCTeX, the string is first processed with the -`reftex-index-math-format', which see. - -\(fn &optional ARG PHRASE)" t nil) - -(autoload 'reftex-index "reftex-index" "\ -Query for an index macro and insert it along with its arguments. -The index macros available are those defined in `reftex-index-macro' or -by a call to `reftex-add-index-macros', typically from an AUCTeX style file. -RefteX provides completion for the index tag and the index key, and -will prompt for other arguments. - -\(fn &optional CHAR KEY TAG SEL NO-INSERT)" t nil) - -(autoload 'reftex-index-complete-tag "reftex-index" "\ - - -\(fn &optional ITAG OPT-ARGS)" nil nil) - -(autoload 'reftex-index-select-tag "reftex-index" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-index-complete-key "reftex-index" "\ - - -\(fn &optional TAG OPTIONAL INITIAL)" nil nil) - -(autoload 'reftex-index-show-entry "reftex-index" "\ - - -\(fn DATA &optional NO-REVISIT)" nil nil) - -(autoload 'reftex-display-index "reftex-index" "\ -Display a buffer with an index compiled from the current document. -When the document has multiple indices, first prompts for the correct one. -When index support is turned off, offer to turn it on. -With one or two `C-u' prefixes, rescan document first. -With prefix 2, restrict index to current document section. -With prefix 3, restrict index to region. - -\(fn &optional TAG OVERRIDING-RESTRICTION REDO &rest LOCATIONS)" t nil) - -(autoload 'reftex-index-phrase-selection-or-word "reftex-index" "\ -Add current selection or word at point to the phrases buffer. -When you are in transient-mark-mode and the region is active, the -selection will be used - otherwise the word at point. -You get a chance to edit the entry in the phrases buffer - finish with -`C-c C-c'. - -\(fn ARG)" t nil) - -(autoload 'reftex-index-visit-phrases-buffer "reftex-index" "\ -Switch to the phrases buffer, initialize if empty. - -\(fn)" t nil) - -(autoload 'reftex-index-phrases-mode "reftex-index" "\ -Major mode for managing the Index phrases of a LaTeX document. -This buffer was created with RefTeX. - -To insert new phrases, use - - `C-c \\' in the LaTeX document to copy selection or word - - `\\[reftex-index-new-phrase]' in the phrases buffer. - -To index phrases use one of: - -\\[reftex-index-this-phrase] index current phrase -\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) -\\[reftex-index-all-phrases] index all phrases -\\[reftex-index-remaining-phrases] index current and following phrases -\\[reftex-index-region-phrases] index the phrases in the region - -You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. -To display information about the phrase at point, use \\[reftex-index-phrases-info]. - -For more information see the RefTeX User Manual. - -Here are all local bindings. - -\\{reftex-index-phrases-mode-map} - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "2818075c906b05c307e008d92e913281") -;;; Generated autoloads from reftex-parse.el - -(autoload 'reftex-parse-one "reftex-parse" "\ -Re-parse this file. - -\(fn)" t nil) - -(autoload 'reftex-parse-all "reftex-parse" "\ -Re-parse entire document. - -\(fn)" t nil) - -(autoload 'reftex-do-parse "reftex-parse" "\ -Do a document rescan. -When allowed, do only a partial scan from FILE. - -\(fn RESCAN &optional FILE)" nil nil) - -(autoload 'reftex-everything-regexp "reftex-parse" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-all-document-files "reftex-parse" "\ -Return a list of all files belonging to the current document. -When RELATIVE is non-nil, give file names relative to directory -of master file. - -\(fn &optional RELATIVE)" nil nil) - -(autoload 'reftex-locate-bibliography-files "reftex-parse" "\ -Scan buffer for bibliography macros and return file list. - -\(fn MASTER-DIR &optional FILES)" nil nil) - -(autoload 'reftex-section-info "reftex-parse" "\ -Return a section entry for the current match. -Careful: This function expects the match-data to be still in place! - -\(fn FILE)" nil nil) - -(autoload 'reftex-ensure-index-support "reftex-parse" "\ -When index support is turned off, ask to turn it on and -set the current prefix argument so that `reftex-access-scan-info' -will rescan the entire document. - -\(fn &optional ABORT)" nil nil) - -(autoload 'reftex-index-info-safe "reftex-parse" "\ - - -\(fn FILE)" nil nil) - -(autoload 'reftex-index-info "reftex-parse" "\ -Return an index entry for the current match. -Careful: This function expects the match-data to be still in place! - -\(fn FILE)" nil nil) - -(autoload 'reftex-short-context "reftex-parse" "\ -Get about one line of useful context for the label definition at point. - -\(fn ENV PARSE &optional BOUND DERIVE)" nil nil) - -(autoload 'reftex-where-am-I "reftex-parse" "\ -Return the docstruct entry above point. -Actually returns a cons cell in which the cdr is a flag indicating -if the information is exact (t) or approximate (nil). - -\(fn)" nil nil) - -(autoload 'reftex-notice-new "reftex-parse" "\ -Hook to handshake with RefTeX after something new has been inserted. - -\(fn &optional N FORCE)" nil nil) - -(autoload 'reftex-what-macro-safe "reftex-parse" "\ -Call `reftex-what-macro' with special syntax table. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-macro "reftex-parse" "\ -Find out if point is within the arguments of any TeX-macro. -The return value is either (\"\\macro\" . (point)) or a list of them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing macro. -If WHICH is t, return list of all macros enclosing point. -If WHICH is a list of macros, look only for those macros and return the - name of the first macro in this list found to enclose point. -If the optional BOUND is an integer, bound backwards directed - searches to this point. If it is nil, limit to nearest \\section - - like statement. - -This function is pretty stable, but can be fooled if the text contains -things like \\macro{aa}{bb} where \\macro is defined to take only one -argument. As RefTeX cannot know this, the string \"bb\" would still be -considered an argument of macro \\macro. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-environment "reftex-parse" "\ -Find out if point is inside a LaTeX environment. -The return value is (e.g.) either (\"equation\" . (point)) or a list of -them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing environment. -If WHICH is t, return list of all environments enclosing point. -If WHICH is a list of environments, look only for those environments and - return the name of the first environment in this list found to enclose - point. - -If the optional BOUND is an integer, bound backwards directed searches to -this point. If it is nil, limit to nearest \\section - like statement. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-special-env "reftex-parse" "\ -Run the special environment parsers and return the matches. - -The return value is (e.g.) either (\"my-parser-function\" . (point)) -or a list of them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing environment. -If WHICH is t, return list of all environments enclosing point. -If WHICH is a list of environments, look only for those environments and - return the name of the first environment in this list found to enclose - point. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-nth-arg "reftex-parse" "\ -Return the Nth following {} or [] parentheses content. -OPT-ARGS is a list of argument numbers which are optional. - -\(fn N &optional OPT-ARGS)" nil nil) - -(autoload 'reftex-move-over-touching-args "reftex-parse" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-init-section-numbers "reftex-parse" "\ -Initialize the section numbers with zeros or with what is found in the TOC-ENTRY. - -\(fn &optional TOC-ENTRY APPENDIX)" nil nil) - -(autoload 'reftex-section-number "reftex-parse" "\ -Return a string with the current section number. -When LEVEL is non-nil, increase section numbers on that level. - -\(fn &optional LEVEL STAR)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-ref" "reftex-ref.el" "e451b141e229c3b5a02cb82ac45a8c94") -;;; Generated autoloads from reftex-ref.el - -(autoload 'reftex-label-location "reftex-ref" "\ -Return the environment or macro which determines the label type at point. -If optional BOUND is an integer, limit backward searches to that point. - -\(fn &optional BOUND)" nil nil) - -(autoload 'reftex-label-info-update "reftex-ref" "\ - - -\(fn CELL)" nil nil) - -(autoload 'reftex-label-info "reftex-ref" "\ - - -\(fn LABEL &optional FILE BOUND DERIVE ENV-OR-MAC)" nil nil) - -(autoload 'reftex-label "reftex-ref" "\ -Insert a unique label. Return the label. -If ENVIRONMENT is given, don't bother to find out yourself. -If NO-INSERT is non-nil, do not insert label into buffer. -With prefix arg, force to rescan document first. -When you are prompted to enter or confirm a label, and you reply with -just the prefix or an empty string, no label at all will be inserted. -A new label is also recorded into the label list. -This function is controlled by the settings of reftex-insert-label-flags. - -\(fn &optional ENVIRONMENT NO-INSERT)" t nil) - -(autoload 'reftex-reference "reftex-ref" "\ -Make a LaTeX reference. Look only for labels of a certain TYPE. -With prefix arg, force to rescan buffer for labels. This should only be -necessary if you have recently entered labels yourself without using -reftex-label. Rescanning of the buffer can also be requested from the -label selection menu. -The function returns the selected label or nil. -If NO-INSERT is non-nil, do not insert \\ref command, just return label. -When called with 2 C-u prefix args, disable magic word recognition. - -\(fn &optional TYPE NO-INSERT CUT)" t nil) - -(autoload 'reftex-query-label-type "reftex-ref" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-show-label-location "reftex-ref" "\ - - -\(fn DATA FORWARD NO-REVISIT &optional STAY ERROR)" nil nil) - -(autoload 'reftex-goto-label "reftex-ref" "\ -Prompt for a label (with completion) and jump to the location of this label. -Optional prefix argument OTHER-WINDOW goes to the label in another window. - -\(fn &optional OTHER-WINDOW)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-sel" "reftex-sel.el" "a01544ca4bc0f41a1f9b8e993b1773e6") -;;; Generated autoloads from reftex-sel.el - -(autoload 'reftex-select-label-mode "reftex-sel" "\ -Major mode for selecting a label in a LaTeX document. -This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a -selection process. -To select a label, move the cursor to it and press RET. -Press `?' for a summary of important key bindings. - -During a selection process, these are the local bindings. - -\\{reftex-select-label-mode-map} - -\(fn)" t nil) - -(autoload 'reftex-select-bib-mode "reftex-sel" "\ -Major mode for selecting a citation key in a LaTeX document. -This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a -selection process. -In order to select a citation, move the cursor to it and press RET. -Press `?' for a summary of important key bindings. - -During a selection process, these are the local bindings. - -\\{reftex-select-label-mode-map} - -\(fn)" t nil) - -(autoload 'reftex-get-offset "reftex-sel" "\ - - -\(fn BUF HERE-AM-I &optional TYPEKEY TOC INDEX FILE)" nil nil) - -(autoload 'reftex-insert-docstruct "reftex-sel" "\ - - -\(fn BUF TOC LABELS INDEX-ENTRIES FILES CONTEXT COUNTER SHOW-COMMENTED HERE-I-AM XR-PREFIX TOC-BUFFER)" nil nil) - -(autoload 'reftex-find-start-point "reftex-sel" "\ - - -\(fn FALLBACK &rest LOCATIONS)" nil nil) - -(autoload 'reftex-select-item "reftex-sel" "\ - - -\(fn REFTEX-SELECT-PROMPT HELP-STRING KEYMAP &optional OFFSET CALL-BACK CB-FLAG)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-toc" "reftex-toc.el" "449ebfd38bdfaa2b8493c3e08a5a9ab3") -;;; Generated autoloads from reftex-toc.el - -(autoload 'reftex-toc "reftex-toc" "\ -Show the table of contents for the current document. -When called with a raw C-u prefix, rescan the document first. - -\(fn &optional REBUILD REUSE)" t nil) - -(autoload 'reftex-toc-recenter "reftex-toc" "\ -Display the TOC window and highlight line corresponding to current position. - -\(fn &optional ARG)" t nil) - -(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "\ -Toggle the automatic recentering of the TOC window. -When active, leaving point idle will make the TOC window jump to the correct -section. - -\(fn)" t nil) - -;;;*** - -;;; End of automatically extracted autoloads. - (provide 'reftex) ;;; reftex.el ends here diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 7fbacbe358c..9143f97dce0 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1,9 +1,9 @@ -;;; rst.el --- Mode for viewing and editing reStructuredText-documents. +;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*- ;; Copyright (C) 2003-2017 Free Software Foundation, Inc. -;; Maintainer: Stefan Merten <smerten@oekonux.de> -;; Author: Stefan Merten <smerten@oekonux.de>, +;; Maintainer: Stefan Merten <stefan at merten-home dot de> +;; Author: Stefan Merten <stefan at merten-home dot de>, ;; Martin Blais <blais@furius.ca>, ;; David Goodger <goodger@python.org>, ;; Wei-Wei Guo <wwguocn@gmail.com> @@ -53,10 +53,10 @@ ;; For full details on how to use the contents of this file, see ;; http://docutils.sourceforge.net/docs/user/emacs.html ;; -;; -;; There are a number of convenient key bindings provided by rst-mode. -;; For more on bindings, see rst-mode-map below. There are also many variables -;; that can be customized, look for defcustom in this file. +;; There are a number of convenient key bindings provided by rst-mode. For the +;; bindings, try C-c C-h when in rst-mode. There are also many variables that +;; can be customized, look for defcustom in this file or look for the "rst" +;; customization group contained in the "wp" group. ;; ;; If you use the table-of-contents feature, you may want to add a hook to ;; update the TOC automatically every time you adjust a section title:: @@ -68,11 +68,6 @@ ;; ;; (setq font-lock-global-modes '(not rst-mode ...)) ;; -;; -;; -;; Customization is done by customizable variables contained in customization -;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. -;; ;;; DOWNLOAD @@ -105,15 +100,30 @@ ;; FIXME: Check through major mode conventions again. -;; FIXME: Add proper ";;;###autoload" comments. - -;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- -;; lexical-binding: t -*-" in the first line. - -;; FIXME: Use `testcover'. +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. -;; FIXME: The adornment classification often called `ado' should be a -;; `defstruct'. +;; Common Lisp stuff +(require 'cl-lib) + +;; Correct wrong declaration. +(def-edebug-spec push + (&or [form symbolp] [form gv-place])) + +;; Correct wrong declaration. This still doesn't support dotted destructuring +;; though. +(def-edebug-spec cl-lambda-list + (([&rest cl-macro-arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" arg]] + [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + ))) + +;; Add missing declaration. +(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good + ;; enough. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -134,9 +144,9 @@ considered constants. Revert it with this function after each `defcustom'." (setq testcover-module-constants (delq nil (mapcar - (lambda (sym) - (if (not (plist-member (symbol-plist sym) 'standard-value)) - sym)) + #'(lambda (sym) + (if (not (plist-member (symbol-plist sym) 'standard-value)) + sym)) testcover-module-constants))))) (defun rst-testcover-add-compose (fun) @@ -149,63 +159,79 @@ considered constants. Revert it with this function after each `defcustom'." (when (boundp 'testcover-1value-functions) (add-to-list 'testcover-1value-functions fun))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Common Lisp stuff - -;; Only use of macros is allowed - may be replaced by `cl-lib' some time. -(eval-when-compile - (require 'cl)) - -;; Redefine some functions from `cl.el' in a proper namespace until they may be -;; used from there. +;; Helpers. + +(cl-defmacro rst-destructuring-dolist + ((arglist list &optional result) &rest body) + "`cl-dolist' with destructuring of the list elements. +ARGLIST is a Common List argument list which may include +destructuring. LIST, RESULT and BODY are as for `cl-dolist'. +Note that definitions in ARGLIST are visible only in the BODY and +neither in RESULT nor in LIST." + ;; FIXME: It would be very useful if the definitions in ARGLIST would be + ;; visible in RESULT. But may be this is rather a + ;; `rst-destructuring-do' then. + (declare (debug + (&define ([&or symbolp cl-macro-list] def-form &optional def-form) + cl-declarations def-body)) + (indent 1)) + (let ((var (make-symbol "--rst-destructuring-dolist-var--"))) + `(cl-dolist (,var ,list ,result) + (cl-destructuring-bind ,arglist ,var + ,@body)))) + +(defun rst-forward-line-strict (n &optional limit) + ;; testcover: ok. + "Try to move point to beginning of line I + N where I is the current line. +Return t if movement is successful. Otherwise don't move point +and return nil. If a position is given by LIMIT, movement +happened but the following line is missing and thus its beginning +can not be reached but the movement reached at least LIMIT +consider this a successful movement. LIMIT is ignored in other +cases." + (let ((start (point))) + (if (and (zerop (forward-line n)) + (or (bolp) + (and limit + (>= (point) limit)))) + t + (goto-char start) + nil))) -(defun rst-signum (x) - "Return 1 if X is positive, -1 if negative, 0 if zero." - (cond - ((> x 0) 1) - ((< x 0) -1) - (t 0))) - -(defun rst-some (seq &optional pred) - "Return non-nil if any element of SEQ yields non-nil when PRED is applied. -Apply PRED to each element of list SEQ until the first non-nil -result is yielded and return this result. PRED defaults to -`identity'." - (unless pred - (setq pred 'identity)) - (catch 'rst-some - (dolist (elem seq) - (let ((r (funcall pred elem))) - (when r - (throw 'rst-some r)))))) - -(defun rst-position-if (pred seq) - "Return position of first element satisfying PRED in list SEQ or nil." - (catch 'rst-position-if - (let ((i 0)) - (dolist (elem seq) - (when (funcall pred elem) - (throw 'rst-position-if i)) - (incf i))))) - -(defun rst-position (elem seq) - "Return position of ELEM in list SEQ or nil. -Comparison done with `equal'." - ;; Create a closure containing `elem' so the `lambda' always sees our - ;; parameter instead of an `elem' which may be in dynamic scope at the time - ;; of execution of the `lambda'. - (lexical-let ((elem elem)) - (rst-position-if (function (lambda (e) - (equal elem e))) - seq))) +(defun rst-forward-line-looking-at (n rst-re-args &optional fun) + ;; testcover: ok. + "Move forward N lines and if successful check whether RST-RE-ARGS is matched. +Moving forward is done by `rst-forward-line-strict'. RST-RE-ARGS +is a single or a list of arguments for `rst-re'. FUN is a +function defaulting to `identity' which is called after the call +to `looking-at' receiving its return value as the first argument. +When FUN is called match data is just set by `looking-at' and +point is at the beginning of the line. Return nil if moving +forward failed or otherwise the return value of FUN. Preserve +global match data, point, mark and current buffer." + (unless (listp rst-re-args) + (setq rst-re-args (list rst-re-args))) + (unless fun + (setq fun #'identity)) + (save-match-data + (save-excursion + (when (rst-forward-line-strict n) + (funcall fun (looking-at (apply #'rst-re rst-re-args))))))) -;; FIXME: Embed complicated `defconst's in `eval-when-compile'. +(rst-testcover-add-1value 'rst-delete-entire-line) +(defun rst-delete-entire-line (n) + "Move N lines and delete the entire line." + (delete-region (line-beginning-position (+ n 1)) + (line-beginning-position (+ n 2)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Versions -;; testcover: ok. (defun rst-extract-version (delim-re head-re re tail-re var &optional default) + ;; testcover: ok. "Extract the version from a variable according to the given regexes. Return the version after regex DELIM-RE and HEAD-RE matching RE and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." @@ -218,7 +244,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.26 2015/10/04 09:26:04 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.9 2017/01/08 09:54:50 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -232,22 +258,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use LastChanged... to really get information from SVN. (defconst rst-svn-rev (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " - "$LastChangedRevision: 7925 $") + "$LastChangedRevision: 8015 $") "The SVN revision of this file. SVN revision is the upstream (docutils) revision.") (defconst rst-svn-timestamp (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " - "$LastChangedDate: 2015-10-04 11:21:35 +0200 (Sun, 04 Oct 2015) $") + "$LastChangedDate: 2017-01-08 10:54:35 +0100 (Sun, 08 Jan 2017) $") "The SVN time stamp of this file.") ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.4.1 %") + "%OfficialVersion: 1.5.2 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%Revision: 1.327.2.25 %") + "$Revision: 1.1058.2.9 $") "CVS revision of this file in the official version.") (defconst rst-version @@ -268,6 +294,11 @@ in parentheses follows the development revision and the time stamp.") ("1.3.1" . "24.3") ("1.4.0" . "24.3") ("1.4.1" . "25.1") + ("1.4.2" . "24.5") + ("1.5.0" . "26.1") + ("1.5.1" . "26.2") + ("1.5.2" . "26.2") + ;; Whatever the Emacs version is this rst.el version ends up in. )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -277,12 +308,12 @@ in parentheses follows the development revision and the time stamp.") (add-to-list 'customize-package-emacs-version-alist (cons 'ReST rst-package-emacs-version-alist)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialize customization - (defgroup rst nil "Support for reStructuredText documents." - :group 'wp + :group 'text :version "23.1" :link '(url-link "http://docutils.sourceforge.net/rst.html")) @@ -358,6 +389,7 @@ in parentheses follows the development revision and the time stamp.") ;; Various starts (bul-sta bul-tag bli-sfx) ; Start of a bulleted item. + (bul-beg lin-beg bul-sta) ; A bullet item at the beginning of a line. ;; Explicit markup tag (`exm') (exm-tag "\\.\\.") @@ -490,8 +522,10 @@ in parentheses follows the development revision and the time stamp.") ; character. ;; Titles (`ttl') - (ttl-tag "\\S *\\w\\S *") ; A title text. - (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line. + (ttl-tag "\\S *\\w.*\\S ") ; A title text. + (ttl-beg-1 lin-beg (:grp ttl-tag)) ; A title text at the beginning of a + ; line. First group is the complete, + ; trimmed title text. ;; Directives and substitution definitions (`dir') (dir-tag-3 (:grp exm-sta) @@ -531,8 +565,8 @@ argument list for `rst-re'.") ;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. (rst-testcover-add-compose 'rst-re) -;; testcover: ok. (defun rst-re (&rest args) + ;; testcover: ok. "Interpret ARGS as regular expressions and return a regex string. Each element of ARGS may be one of the following: @@ -559,34 +593,34 @@ referenceable group (\"\\(...\\)\"). After interpretation of ARGS the results are concatenated as for `:seq'." - (apply 'concat + (apply #'concat (mapcar - (lambda (re) - (cond - ((stringp re) - re) - ((symbolp re) - (cadr (assoc re rst-re-alist))) - ((characterp re) - (regexp-quote (char-to-string re))) - ((listp re) - (let ((nested - (mapcar (lambda (elt) - (rst-re elt)) - (cdr re)))) - (cond - ((eq (car re) :seq) - (mapconcat 'identity nested "")) - ((eq (car re) :shy) - (concat "\\(?:" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :grp) - (concat "\\(" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :alt) - (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)")) - (t - (error "Unknown list car: %s" (car re)))))) - (t - (error "Unknown object type for building regex: %s" re)))) + #'(lambda (re) + (cond + ((stringp re) + re) + ((symbolp re) + (cadr (assoc re rst-re-alist))) + ((characterp re) + (regexp-quote (char-to-string re))) + ((listp re) + (let ((nested + (mapcar (lambda (elt) + (rst-re elt)) + (cdr re)))) + (cond + ((eq (car re) :seq) + (mapconcat #'identity nested "")) + ((eq (car re) :shy) + (concat "\\(?:" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :grp) + (concat "\\(" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :alt) + (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)")) + (t + (error "Unknown list car: %s" (car re)))))) + (t + (error "Unknown object type for building regex: %s" re)))) args))) ;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'. @@ -598,15 +632,546 @@ After interpretation of ARGS the results are concatenated as for (dolist (re rst-re-alist-def rst-re-alist) (setq rst-re-alist (nconc rst-re-alist - (list (list (car re) (apply 'rst-re (cdr re)))))))) + (list (list (car re) (apply #'rst-re (cdr re)))))))) "Alist mapping symbols from `rst-re-alist-def' to regex strings.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Concepts + +;; Each of the following classes represents an own concept. The suffix of the +;; class name is used in the code to represent entities of the respective +;; class. +;; +;; In addition a reStructuredText section header in the buffer is called +;; "section". +;; +;; For lists a "s" is added to the name of the concepts. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ado + +(cl-defstruct + (rst-Ado + (:constructor nil) ; Prevent creating unchecked values. + ;; Construct a transition. + (:constructor + rst-Ado-new-transition + (&aux + (char nil) + (-style 'transition))) + ;; Construct a simple section header. + (:constructor + rst-Ado-new-simple + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'simple))) + ;; Construct a over-and-under section header. + (:constructor + rst-Ado-new-over-and-under + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'over-and-under))) + ;; Construct from adornment with inverted style. + (:constructor + rst-Ado-new-invert + (ado-arg + &aux + (char (rst-Ado-char ado-arg)) + (-style (let ((sty (rst-Ado--style ado-arg))) + (cond + ((eq sty 'simple) + 'over-and-under) + ((eq sty 'over-and-under) + 'simple) + (sty))))))) + "Representation of a reStructuredText adornment. +Adornments are either section markers where they markup the +section header or transitions. + +This type is immutable." + ;; The character used for the adornment. + (char nil :read-only t) + ;; The style of the adornment. This is a private attribute. + (-style nil :read-only t)) + +;; Private class methods + +(defun rst-Ado--validate-char (char) + ;; testcover: ok. + "Validate CHAR to be a valid adornment character. +Return CHAR if so or signal an error otherwise." + (cl-check-type char character) + (cl-check-type char (satisfies + (lambda (c) + (memq c rst-adornment-chars))) + "Character must be a valid adornment character") + char) + +;; Public methods + +(defun rst-Ado-is-transition (self) + ;; testcover: ok. + "Return non-nil if SELF is a transition adornment." + (cl-check-type self rst-Ado) + (eq (rst-Ado--style self) 'transition)) + +(defun rst-Ado-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section adornment." + (cl-check-type self rst-Ado) + (not (rst-Ado-is-transition self))) + +(defun rst-Ado-is-simple (self) + ;; testcover: ok. + "Return non-nil if SELF is a simple section adornment." + (cl-check-type self rst-Ado) + (eq (rst-Ado--style self) 'simple)) + +(defun rst-Ado-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section adornment." + (cl-check-type self rst-Ado) + (eq (rst-Ado--style self) 'over-and-under)) + +(defun rst-Ado-equal (self other) + ;; testcover: ok. + "Return non-nil when SELF and OTHER are equal." + (cl-check-type self rst-Ado) + (cl-check-type other rst-Ado) + (cond + ((not (eq (rst-Ado--style self) (rst-Ado--style other))) + nil) + ((rst-Ado-is-transition self)) + ((equal (rst-Ado-char self) (rst-Ado-char other))))) + +(defun rst-Ado-position (self ados) + ;; testcover: ok. + "Return position of SELF in ADOS or nil." + (cl-check-type self rst-Ado) + (cl-position-if #'(lambda (e) + (rst-Ado-equal self e)) + ados)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Hdr + +(cl-defstruct + (rst-Hdr + (:constructor nil) ; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Hdr-new + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado nil)))) + ;; Construct while all parameters but `indent' must be valid. + (:constructor + rst-Hdr-new-lax + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + ;; Construct a header with same characteristics but opposite style as `ado'. + (:constructor + rst-Hdr-new-invert + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + (:copier nil)) ; Not really needed for an immutable type. + "Representation of reStructuredText section header characteristics. + +This type is immutable." + ;; The adornment of the header. + (ado nil :read-only t) + ;; The indentation of a title text or nil if not given. + (indent nil :read-only t)) + +;; Private class methods + +(defun rst-Hdr--validate-indent (indent ado lax) + ;; testcover: ok. + "Validate INDENT to be a valid indentation for ADO. +Return INDENT if so or signal an error otherwise. If LAX don't +signal an error and return a valid indent." + (cl-check-type indent integer) + (cond + ((zerop indent) + indent) + ((rst-Ado-is-simple ado) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must be 0 for style simple")))) + ((< indent 0) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must not be negative")))) + ;; Implicitly over-and-under. + (indent))) + +(defun rst-Hdr--validate-ado (ado) + ;; testcover: ok. + "Validate ADO to be a valid adornment. +Return ADO if so or signal an error otherwise." + (cl-check-type ado rst-Ado) + (cond + ((rst-Ado-is-transition ado) + (signal 'args-out-of-range + '("Adornment for header must not be transition."))) + (ado))) + +;; Public class methods + +(defvar rst-preferred-adornments) ; Forward declaration. + +(defun rst-Hdr-preferred-adornments () + ;; testcover: ok. + "Return preferred adornments as list of `rst-Hdr'." + (mapcar (cl-function + (lambda ((character style indent)) + (rst-Hdr-new-lax + (if (eq style 'over-and-under) + (rst-Ado-new-over-and-under character) + (rst-Ado-new-simple character)) + indent))) + rst-preferred-adornments)) + +;; Public methods + +(defun rst-Hdr-member-ado (self hdrs) + ;; testcover: ok. + "Return sublist of HDRS whose car's adornment equals that of SELF or nil." + (cl-check-type self rst-Hdr) + (let ((ado (rst-Hdr-ado self))) + (cl-member-if #'(lambda (hdr) + (rst-Ado-equal ado (rst-Hdr-ado hdr))) + hdrs))) + +(defun rst-Hdr-ado-map (selves) + ;; testcover: ok. + "Return `rst-Ado' list extracted from elements of SELVES." + (mapcar #'rst-Hdr-ado selves)) + +(defun rst-Hdr-get-char (self) + ;; testcover: ok. + "Return character of the adornment of SELF." + (cl-check-type self rst-Hdr) + (rst-Ado-char (rst-Hdr-ado self))) + +(defun rst-Hdr-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section header." + (cl-check-type self rst-Hdr) + (rst-Ado-is-over-and-under (rst-Hdr-ado self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ttl + +(cl-defstruct + (rst-Ttl + (:constructor nil) ; Prevent creating unchecked values. + ;; Construct with valid parameters for all attributes. + (:constructor ; Private constructor + rst-Ttl--new + (ado-arg + match-arg + indent-arg + text-arg + &aux + (ado (rst-Ttl--validate-ado ado-arg)) + (match (rst-Ttl--validate-match match-arg ado)) + (indent (rst-Ttl--validate-indent indent-arg ado)) + (text (rst-Ttl--validate-text text-arg ado)) + (hdr (condition-case nil + (rst-Hdr-new ado indent) + (error nil))))) + (:copier nil)) ; Not really needed for an immutable type. + "Representation of a reStructuredText section header as found in a buffer. +This type gathers information about an adorned part in the buffer. + +This type is immutable." + ;; The adornment characteristics or nil for a title candidate. + (ado nil :read-only t) + ;; The match-data for `ado' in a form similarly returned by `match-data' (but + ;; not necessarily with markers in buffers). Match group 0 matches the whole + ;; construct. Match group 1 matches the overline adornment if present. + ;; Match group 2 matches the section title text or the transition. Match + ;; group 3 matches the underline adornment. + (match nil :read-only t) + ;; An indentation found for the title line or nil for a transition. + (indent nil :read-only t) + ;; The text of the title or nil for a transition. + (text nil :read-only t) + ;; The header characteristics if it is a valid section header. + (hdr nil :read-only t) + ;; FIXME refactoring: Should have an attribute `buffer' for the buffer this + ;; title is found in. This breaks lots and lots of tests. + ;; However, with private constructor they may not be + ;; necessary any more. In case it is really a buffer then + ;; also `match' could be real data from `match-data' which + ;; contains markers instead of integers. + ) + +;; Private class methods + +(defun rst-Ttl--validate-ado (ado) + ;; testcover: ok. + "Return valid ADO or signal error." + (cl-check-type ado (or null rst-Ado)) + ado) + +(defun rst-Ttl--validate-match (match ado) + ;; testcover: ok. + "Return valid MATCH matching ADO or signal error." + (cl-check-type ado (or null rst-Ado)) + (cl-check-type match list) + (cl-check-type match (satisfies (lambda (m) + (equal (length m) 8))) + "Match data must consist of exactly 8 buffer positions.") + (dolist (pos match) + (cl-check-type pos (or null integer-or-marker))) + (cl-destructuring-bind (all-beg all-end + ovr-beg ovr-end + txt-beg txt-end + und-beg und-end) match + (unless (and (integer-or-marker-p all-beg) (integer-or-marker-p all-end)) + (signal 'args-out-of-range + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a title candidate exactly the third match pair must be set.")))) + ((rst-Ado-is-transition ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (integer-or-marker-p und-beg) (integer-or-marker-p und-end)) + (signal 'args-out-of-range + '("For a simple section adornment exactly the third and fourth match pair must be set.")))) + (t ; over-and-under + (unless (and (integer-or-marker-p ovr-beg) (integer-or-marker-p ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (or (null und-beg) (integer-or-marker-p und-beg)) + (or (null und-end) (integer-or-marker-p und-end))) + (signal 'args-out-of-range + '("For a over-and-under section adornment all match pairs must be set.")))))) + match) + +(defun rst-Ttl--validate-indent (indent ado) + ;; testcover: ok. + "Return valid INDENT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (cl-check-type indent null + "Indent for a transition must be nil.") + (cl-check-type indent (integer 0 *) + "Indent for a section header must be non-negative.")) + indent) + +(defun rst-Ttl--validate-text (text ado) + ;; testcover: ok. + "Return valid TEXT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (cl-check-type text null + "Transitions may not have title text.") + (cl-check-type text string)) + text) + +;; Public class methods + +(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt) + ;; testcover: ok. + "Return a `rst-Ttl' constructed from information in the current buffer. +ADO is the adornment or nil for a title candidate. BEG-OVR and +BEG-UND are the starting points of the overline or underline, +respectively. They may be nil if the respective thing is missing. +BEG-TXT is the beginning of the title line or the transition and +must be given. The end of the line is used as the end point. TXT +is the title text or nil. If TXT is given the indentation of the +line containing BEG-TXT is used as indentation. Match group 0 is +derived from the remaining information." + (cl-check-type beg-txt integer-or-marker) + (save-excursion + (let ((end-ovr (when beg-ovr + (goto-char beg-ovr) + (line-end-position))) + (end-txt (progn + (goto-char beg-txt) + (line-end-position))) + (end-und (when beg-und + (goto-char beg-und) + (line-end-position))) + (ind (when txt + (goto-char beg-txt) + (current-indentation)))) + (rst-Ttl--new ado + (list + (or beg-ovr beg-txt) (or end-und end-txt) + beg-ovr end-ovr + beg-txt end-txt + beg-und end-und) + ind txt)))) + +;; Public methods + +(defun rst-Ttl-get-title-beginning (self) + ;; testcover: ok. + "Return position of beginning of title text of SELF. +This position should always be at the start of a line." + (cl-check-type self rst-Ttl) + (nth 4 (rst-Ttl-match self))) + +(defun rst-Ttl-get-beginning (self) + ;; testcover: ok. + "Return position of beginning of whole SELF." + (cl-check-type self rst-Ttl) + (nth 0 (rst-Ttl-match self))) + +(defun rst-Ttl-get-end (self) + ;; testcover: ok. + "Return position of end of whole SELF." + (cl-check-type self rst-Ttl) + (nth 1 (rst-Ttl-match self))) + +(defun rst-Ttl-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section header or candidate." + (cl-check-type self rst-Ttl) + (rst-Ttl-text self)) + +(defun rst-Ttl-is-candidate (self) + ;; testcover: ok. + "Return non-nil if SELF is a candidate for a section header." + (cl-check-type self rst-Ttl) + (not (rst-Ttl-ado self))) + +(defun rst-Ttl-contains (self position) + "Return whether SELF contain POSITION. +Return 0 if SELF contains POSITION, < 0 if SELF ends before +POSITION and > 0 if SELF starts after position." + (cl-check-type self rst-Ttl) + (cl-check-type position integer-or-marker) + (cond + ((< (nth 1 (rst-Ttl-match self)) position) + -1) + ((> (nth 0 (rst-Ttl-match self)) position) + +1) + (0))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Stn + +(cl-defstruct + (rst-Stn + (:constructor nil) ; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Stn-new + (ttl-arg + level-arg + children-arg + &aux + (ttl (rst-Stn--validate-ttl ttl-arg)) + (level (rst-Stn--validate-level level-arg ttl)) + (children (rst-Stn--validate-children children-arg ttl))))) + "Representation of a section tree node. + +This type is immutable." + ;; The title of the node or nil for a missing node. + (ttl nil :read-only t) + ;; The level of the node in the tree. Negative for the (virtual) top level + ;; node. + (level nil :read-only t) + ;; The list of children of the node. + (children nil :read-only t)) +;; FIXME refactoring: Should have an attribute `buffer' for the buffer this +;; title is found in. Or use `rst-Ttl-buffer'. + +;; Private class methods + +(defun rst-Stn--validate-ttl (ttl) + ;; testcover: ok. + "Return valid TTL or signal error." + (cl-check-type ttl (or null rst-Ttl)) + ttl) + +(defun rst-Stn--validate-level (level ttl) + ;; testcover: ok. + "Return valid LEVEL for TTL or signal error." + (cl-check-type level integer) + (when (and ttl (< level 0)) + ;; testcover: Never reached because a title may not have a negative level + (signal 'args-out-of-range + '("Top level node must not have a title."))) + level) + +(defun rst-Stn--validate-children (children ttl) + ;; testcover: ok. + "Return valid CHILDREN for TTL or signal error." + (cl-check-type children list) + (dolist (child children) + (cl-check-type child rst-Stn)) + (unless (or ttl children) + (signal 'args-out-of-range + '("A missing node must have children."))) + children) + +;; Public methods + +(defun rst-Stn-get-title-beginning (self) + ;; testcover: ok. + "Return the beginning of the title of SELF. +Handles missing node properly." + (cl-check-type self rst-Stn) + (let ((ttl (rst-Stn-ttl self))) + (if ttl + (rst-Ttl-get-title-beginning ttl) + (rst-Stn-get-title-beginning (car (rst-Stn-children self)))))) + +(defun rst-Stn-get-text (self &optional default) + ;; testcover: ok. + "Return title text of SELF or DEFAULT if SELF is a missing node. +For a missing node and no DEFAULT given return a standard title text." + (cl-check-type self rst-Stn) + (let ((ttl (rst-Stn-ttl self))) + (cond + (ttl + (rst-Ttl-text ttl)) + (default) + ("[missing node]")))) + +(defun rst-Stn-is-top (self) + ;; testcover: ok. + "Return non-nil if SELF is a top level node." + (cl-check-type self rst-Stn) + (< (rst-Stn-level self) 0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode definition -;; testcover: ok. (defun rst-define-key (keymap key def &rest deprecated) + ;; testcover: ok. "Bind like `define-key' but add deprecated key definitions. KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key definitions should be in vector notation. These are defined @@ -618,60 +1183,61 @@ as well but give an additional message." (if (string-match "^rst-\\(.*\\)$" command-name) (concat "rst-deprecated-" (match-string 1 command-name)) - (error "not an RST command: %s" command-name))) + (error "Not an RST command: %s" command-name))) (forwarder-function (intern forwarder-function-name))) (unless (fboundp forwarder-function) (defalias forwarder-function - (lexical-let ((key key) (def def)) - (lambda () - (interactive) - (call-interactively def) - (message "[Deprecated use of key %s; use key %s instead]" - (key-description (this-command-keys)) - (key-description key)))) + (lambda () + (interactive) + (call-interactively def) + (message "[Deprecated use of key %s; use key %s instead]" + (key-description (this-command-keys)) + (key-description key))) + ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. (format "Deprecated binding for %s, use \\[%s] instead." def def))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) + ;; Key bindings. (defvar rst-mode-map (let ((map (make-sparse-keymap))) ;; \C-c is the general keymap. - (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-h] #'describe-prefix-bindings) ;; ;; Section Adornments ;; ;; The adjustment function that adorns or rotates a section title. - (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t]) - (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on macOS and - ; on consoles. + (rst-define-key map [?\C-c ?\C-=] #'rst-adjust [?\C-c ?\C-a t]) + (rst-define-key map [?\C-=] #'rst-adjust) ; Does not work on macOS and + ; on consoles. ;; \C-c \C-a is the keymap for adornments. - (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-a ?\C-h] #'describe-prefix-bindings) ;; Another binding which works with all types of input. - (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) + (rst-define-key map [?\C-c ?\C-a ?\C-a] #'rst-adjust) ;; Display the hierarchy of adornments implied by the current document ;; contents. - (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy) + (rst-define-key map [?\C-c ?\C-a ?\C-d] #'rst-display-hdr-hierarchy) ;; Homogenize the adornments in the document. - (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments + (rst-define-key map [?\C-c ?\C-a ?\C-s] #'rst-straighten-sections [?\C-c ?\C-s]) ;; ;; Section Movement and Selection ;; ;; Mark the subsection where the cursor is. - (rst-define-key map [?\C-\M-h] 'rst-mark-section + (rst-define-key map [?\C-\M-h] #'rst-mark-section ;; Same as mark-defun sgml-mark-current-element. [?\C-c ?\C-m]) ;; Move backward/forward between section titles. ;; FIXME: Also bind similar to outline mode. - (rst-define-key map [?\C-\M-a] 'rst-backward-section + (rst-define-key map [?\C-\M-a] #'rst-backward-section ;; Same as beginning-of-defun. [?\C-c ?\C-n]) - (rst-define-key map [?\C-\M-e] 'rst-forward-section + (rst-define-key map [?\C-\M-e] #'rst-forward-section ;; Same as end-of-defun. [?\C-c ?\C-p]) @@ -679,69 +1245,69 @@ as well but give an additional message." ;; Operating on regions ;; ;; \C-c \C-r is the keymap for regions. - (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-r ?\C-h] #'describe-prefix-bindings) ;; Makes region a line-block. - (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region + (rst-define-key map [?\C-c ?\C-r ?\C-l] #'rst-line-block-region [?\C-c ?\C-d]) ;; Shift region left or right according to tabs. - (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region + (rst-define-key map [?\C-c ?\C-r tab] #'rst-shift-region [?\C-c ?\C-r t] [?\C-c ?\C-l t]) ;; ;; Operating on lists ;; ;; \C-c \C-l is the keymap for lists. - (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-l ?\C-h] #'describe-prefix-bindings) ;; Makes paragraphs in region as a bullet list. - (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region + (rst-define-key map [?\C-c ?\C-l ?\C-b] #'rst-bullet-list-region [?\C-c ?\C-b]) ;; Makes paragraphs in region as a enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region + (rst-define-key map [?\C-c ?\C-l ?\C-e] #'rst-enumerate-region [?\C-c ?\C-e]) ;; Converts bullets to an enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration + (rst-define-key map [?\C-c ?\C-l ?\C-c] #'rst-convert-bullets-to-enumeration [?\C-c ?\C-v]) ;; Make sure that all the bullets in the region are consistent. - (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region + (rst-define-key map [?\C-c ?\C-l ?\C-s] #'rst-straighten-bullets-region [?\C-c ?\C-w]) ;; Insert a list item. - (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list) + (rst-define-key map [?\C-c ?\C-l ?\C-i] #'rst-insert-list) ;; ;; Table-of-Contents Features ;; ;; \C-c \C-t is the keymap for table of contents. - (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-t ?\C-h] #'describe-prefix-bindings) ;; Enter a TOC buffer to view and move to a specific section. - (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc) + (rst-define-key map [?\C-c ?\C-t ?\C-t] #'rst-toc) ;; Insert a TOC here. - (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert + (rst-define-key map [?\C-c ?\C-t ?\C-i] #'rst-toc-insert [?\C-c ?\C-i]) ;; Update the document's TOC (without changing the cursor position). - (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update + (rst-define-key map [?\C-c ?\C-t ?\C-u] #'rst-toc-update [?\C-c ?\C-u]) - ;; Go to the section under the cursor (cursor must be in TOC). - (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section + ;; Go to the section under the cursor (cursor must be in internal TOC). + (rst-define-key map [?\C-c ?\C-t ?\C-j] #'rst-toc-follow-link [?\C-c ?\C-f]) ;; ;; Converting Documents from Emacs ;; ;; \C-c \C-c is the keymap for compilation. - (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-c ?\C-h] #'describe-prefix-bindings) ;; Run one of two pre-configured toolset commands on the document. - (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile + (rst-define-key map [?\C-c ?\C-c ?\C-c] #'rst-compile [?\C-c ?1]) - (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset + (rst-define-key map [?\C-c ?\C-c ?\C-a] #'rst-compile-alt-toolset [?\C-c ?2]) ;; Convert the active region to pseudo-xml using the docutils tools. - (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region + (rst-define-key map [?\C-c ?\C-c ?\C-x] #'rst-compile-pseudo-region [?\C-c ?3]) ;; Convert the current document to PDF and launch a viewer on the results. - (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview + (rst-define-key map [?\C-c ?\C-c ?\C-p] #'rst-compile-pdf-preview [?\C-c ?4]) ;; Convert the current document to S5 slides and view in a web browser. - (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview + (rst-define-key map [?\C-c ?\C-c ?\C-s] #'rst-compile-slides-preview [?\C-c ?5]) map) @@ -751,7 +1317,8 @@ This inherits from Text mode.") ;; Abbrevs. (define-abbrev-table 'rst-mode-abbrev-table - (mapcar (lambda (x) (append x '(nil 0 system))) + (mapcar #'(lambda (x) + (append x '(nil 0 system))) '(("contents" ".. contents::\n..\n ") ("con" ".. contents::\n..\n ") ("cont" "[...]") @@ -799,6 +1366,7 @@ The hook for `text-mode' is run before this one." (require 'newcomment) (defvar electric-pair-pairs) +(defvar electric-indent-inhibit) ;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files ;; use *.txt, but this is too generic to be set as a default. @@ -818,71 +1386,62 @@ highlighting. :group 'rst ;; Paragraph recognition. - (set (make-local-variable 'paragraph-separate) - (rst-re '(:alt - "\f" - lin-end))) - (set (make-local-variable 'paragraph-start) - (rst-re '(:alt - "\f" - lin-end - (:seq hws-tag par-tag- bli-sfx)))) + (setq-local paragraph-separate + (rst-re '(:alt + "\f" + lin-end))) + (setq-local paragraph-start + (rst-re '(:alt + "\f" + lin-end + (:seq hws-tag par-tag- bli-sfx)))) ;; Indenting and filling. - (set (make-local-variable 'indent-line-function) 'rst-indent-line) - (set (make-local-variable 'adaptive-fill-mode) t) - (set (make-local-variable 'adaptive-fill-regexp) - (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) - (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill) - (set (make-local-variable 'fill-paragraph-handle-comment) nil) + (setq-local indent-line-function #'rst-indent-line) + (setq-local adaptive-fill-mode t) + (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) + (setq-local adaptive-fill-function #'rst-adaptive-fill) + (setq-local fill-paragraph-handle-comment nil) ;; Comments. - (set (make-local-variable 'comment-start) ".. ") - (set (make-local-variable 'comment-start-skip) - (rst-re 'lin-beg 'exm-tag 'bli-sfx)) - (set (make-local-variable 'comment-continue) " ") - (set (make-local-variable 'comment-multi-line) t) - (set (make-local-variable 'comment-use-syntax) nil) + (setq-local comment-start ".. ") + (setq-local comment-start-skip (rst-re 'lin-beg 'exm-tag 'bli-sfx)) + (setq-local comment-continue " ") + (setq-local comment-multi-line t) + (setq-local comment-use-syntax nil) ;; reStructuredText has not really a comment ender but nil is not really a ;; permissible value. - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-end-skip) nil) + (setq-local comment-end "") + (setq-local comment-end-skip nil) ;; Commenting in reStructuredText is very special so use our own set of ;; functions. - (set (make-local-variable 'comment-line-break-function) - 'rst-comment-line-break) - (set (make-local-variable 'comment-indent-function) - 'rst-comment-indent) - (set (make-local-variable 'comment-insert-comment-function) - 'rst-comment-insert-comment) - (set (make-local-variable 'comment-region-function) - 'rst-comment-region) - (set (make-local-variable 'uncomment-region-function) - 'rst-uncomment-region) - - (set (make-local-variable 'electric-pair-pairs) - '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) + (setq-local comment-line-break-function #'rst-comment-line-break) + (setq-local comment-indent-function #'rst-comment-indent) + (setq-local comment-insert-comment-function #'rst-comment-insert-comment) + (setq-local comment-region-function #'rst-comment-region) + (setq-local uncomment-region-function #'rst-uncomment-region) + + (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. - (set (make-local-variable 'imenu-create-index-function) - 'rst-imenu-create-index) + (setq-local imenu-create-index-function #'rst-imenu-create-index) ;; Font lock. - (set (make-local-variable 'font-lock-defaults) - '(rst-font-lock-keywords - t nil nil nil - (font-lock-multiline . t) - (font-lock-mark-block-function . mark-paragraph))) - (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) + (setq-local font-lock-defaults + '(rst-font-lock-keywords + t nil nil nil + (font-lock-multiline . t) + (font-lock-mark-block-function . mark-paragraph))) + (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t) ;; Text after a changed line may need new fontification. - (set (make-local-variable 'jit-lock-contextually) t) + (setq-local jit-lock-contextually t) ;; Indentation is not deterministic. - (setq electric-indent-inhibit t)) + (setq-local electric-indent-inhibit t)) ;;;###autoload (define-minor-mode rst-minor-mode @@ -908,38 +1467,14 @@ for modes derived from Text mode, like Mail mode." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section Adornment Adjustment -;; ============================ -;; +;; Section adornment adjustment + ;; The following functions implement a smart automatic title sectioning feature. ;; The idea is that with the cursor sitting on a section title, we try to get as ;; much information from context and try to do the best thing automatically. ;; This function can be invoked many times and/or with prefix argument to rotate ;; between the various sectioning adornments. ;; -;; Definitions: the two forms of sectioning define semantically separate section -;; levels. A sectioning ADORNMENT consists in: -;; -;; - a CHARACTER -;; -;; - a STYLE which can be either of 'simple' or 'over-and-under'. -;; -;; - an INDENT (meaningful for the over-and-under style only) which determines -;; how many characters and over-and-under style is hanging outside of the -;; title at the beginning and ending. -;; -;; Here are two examples of adornments (| represents the window border, column -;; 0): -;; -;; | -;; 1. char: '-' e |Some Title -;; style: simple |---------- -;; | -;; 2. char: '=' |============== -;; style: over-and-under | Some Title -;; indent: 2 |============== -;; | -;; ;; Some notes: ;; ;; - The underlining character that is used depends on context. The file is @@ -948,7 +1483,7 @@ for modes derived from Text mode, like Mail mode." ;; rotated among the existing section adornments. ;; ;; Note that when rotating the characters, if we come to the end of the -;; hierarchy of adornments, the variable rst-preferred-adornments is +;; hierarchy of adornments, the variable `rst-preferred-adornments' is ;; consulted to propose a new underline adornment, and if continued, we cycle ;; the adornments all over again. Set this variable to nil if you want to ;; limit the underlining character propositions to the existing adornments in @@ -986,6 +1521,8 @@ for modes derived from Text mode, like Mail mode." (define-obsolete-variable-alias 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0") +;; FIXME: Default must match suggestion in +;; http://sphinx-doc.org/rest.html#sections for Python documentation. (defcustom rst-preferred-adornments '((?= over-and-under 1) (?= simple 0) (?- simple 0) @@ -995,13 +1532,10 @@ for modes derived from Text mode, like Mail mode." (?# simple 0) (?@ simple 0)) "Preferred hierarchy of section title adornments. - A list consisting of lists of the form (CHARACTER STYLE INDENT). CHARACTER is the character used. STYLE is one of the symbols `over-and-under' or `simple'. INDENT is an integer giving the -wanted indentation for STYLE `over-and-under'. CHARACTER and -STYLE are always used when a section adornment is described. -In other places, t instead of a list stands for a transition. +wanted indentation for STYLE `over-and-under'. This sequence is consulted to offer a new adornment suggestion when we rotate the underlines at the end of the existing @@ -1014,9 +1548,9 @@ file." :type `(repeat (group :tag "Adornment specification" (choice :tag "Adornment character" - ,@(mapcar (lambda (char) - (list 'const - :tag (char-to-string char) char)) + ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) rst-adornment-chars)) (radio :tag "Adornment type" (const :tag "Overline and underline" over-and-under) @@ -1025,485 +1559,418 @@ file." :value 0)))) (rst-testcover-defcustom) +;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to +;; 0 because the effect of 1 is probably surprising in the few cases +;; where this is used. +;; FIXME: A matching adornment style can be looked for in +;; `rst-preferred-adornments' and its indentation used before using this +;; variable. (defcustom rst-default-indent 1 "Number of characters to indent the section title. - -This is used for when toggling adornment styles, when switching +This is only used while toggling adornment styles when switching from a simple adornment style to a over-and-under adornment -style." +style. In addition this is used in cases where the adornments +found in the buffer are to be used but the indentation for +over-and-under adornments is inconsistent across the buffer." :group 'rst-adjust :type '(integer)) (rst-testcover-defcustom) -(defun rst-compare-adornments (ado1 ado2) - "Compare adornments. -Return true if both ADO1 and ADO2 adornments are equal, -according to restructured text semantics (only the character -and the style are compared, the indentation does not matter)." - (and (eq (car ado1) (car ado2)) - (eq (cadr ado1) (cadr ado2)))) - - -(defun rst-get-adornment-match (hier ado) - "Return the index (level) in hierarchy HIER of adornment ADO. -This basically just searches for the item using the appropriate -comparison and returns the index. Return nil if the item is -not found." - (let ((cur hier)) - (while (and cur (not (rst-compare-adornments (car cur) ado))) - (setq cur (cdr cur))) - cur)) - -;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test -;; `rst-adjust-no-preference'. -(defun rst-suggest-new-adornment (allados &optional prev) - "Suggest a new, different adornment from all that have been seen. - -ALLADOS is the set of all adornments, including the line numbers. -PREV is the optional previous adornment, in order to suggest a -better match." - - ;; For all the preferred adornments... - (let* ( - ;; If 'prev' is given, reorder the list to start searching after the - ;; match. - (fplist - (cdr (rst-get-adornment-match rst-preferred-adornments prev))) - - ;; List of candidates to search. - (curpotential (append fplist rst-preferred-adornments))) - (while - ;; For all the adornments... - (let ((cur allados) - found) - (while (and cur (not found)) - (if (rst-compare-adornments (car cur) (car curpotential)) - ;; Found it! - (setq found (car curpotential)) - (setq cur (cdr cur)))) - found) - - (setq curpotential (cdr curpotential))) - - (copy-sequence (car curpotential)))) - -(defun rst-delete-entire-line () - "Delete the entire current line without using the `kill-ring'." - (delete-region (line-beginning-position) - (line-beginning-position 2))) - -(defun rst-update-section (char style &optional indent) - "Unconditionally update the style of a section adornment. - -Do this using the given character CHAR, with STYLE `simple' -or `over-and-under', and with indent INDENT. If the STYLE -is `simple', whitespace before the title is removed (indent -is always assumed to be 0). - +(defun rst-new-preferred-hdr (seen prev) + ;; testcover: ok. + "Return a new, preferred `rst-Hdr' different from all in SEEN. +PREV is the previous `rst-Hdr' in the buffer. If given the +search starts after this entry. Return nil if no new preferred +`rst-Hdr' can be found." + ;; All preferred adornments are candidates. + (let ((candidates + (append + (if prev + ;; Start searching after the level of the previous adornment. + (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) + (rst-Hdr-preferred-adornments)))) + (cl-find-if #'(lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates))) + +(defun rst-update-section (hdr) + ;; testcover: ok. + "Unconditionally update the style of the section header at point to HDR. If there are existing overline and/or underline from the existing adornment, they are removed before adding the requested adornment." (end-of-line) - (let ((marker (point-marker)) - len) - - ;; Fixup whitespace at the beginning and end of the line. - (if (or (null indent) (eq style 'simple)) ;; testcover: ok. - (setq indent 0)) - (beginning-of-line) - (delete-horizontal-space) - (insert (make-string indent ? )) - - (end-of-line) - (delete-horizontal-space) - - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) - - ;; Remove previous line if it is an adornment. - (save-excursion - (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line - ;; of buffer. - (if (and (looking-at (rst-re 'ado-beg-2-1)) - ;; Avoid removing the underline of a title right above us. - (save-excursion (forward-line -1) - (not (looking-at (rst-re 'ttl-beg))))) - (rst-delete-entire-line))) - - ;; Remove following line if it is an adornment. - (save-excursion - (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line - ;; of buffer. - (if (looking-at (rst-re 'ado-beg-2-1)) - (rst-delete-entire-line)) - ;; Add a newline if we're at the end of the buffer, for the subsequence - ;; inserting of the underline. - (if (= (point) (buffer-end 1)) - (newline 1))) - - ;; Insert overline. - (if (eq style 'over-and-under) - (save-excursion - (beginning-of-line) - (open-line 1) - (insert (make-string len char)))) - - ;; Insert underline. - (1value ;; Line has been inserted above. - (forward-line +1)) + (let ((indent (or (rst-Hdr-indent hdr) 0)) + (marker (point-marker)) + new) + + ;; Fixup whitespace at the beginning and end of the line. + (1value + (rst-forward-line-strict 0)) + (delete-horizontal-space) + (insert (make-string indent ? )) + (end-of-line) + (delete-horizontal-space) + (setq new (make-string (+ (current-column) indent) (rst-Hdr-get-char hdr))) + + ;; Remove previous line if it is an adornment. + ;; FIXME refactoring: Check whether this deletes `hdr' which *has* all the + ;; data necessary. + (when (and (rst-forward-line-looking-at -1 'ado-beg-2-1) + ;; Avoid removing the underline of a title right above us. + (not (rst-forward-line-looking-at -2 'ttl-beg-1))) + (rst-delete-entire-line -1)) + + ;; Remove following line if it is an adornment. + (when (rst-forward-line-looking-at +1 'ado-beg-2-1) + (rst-delete-entire-line +1)) + + ;; Insert underline. + (unless (rst-forward-line-strict +1) + ;; Normalize buffer by adding final newline. + (newline 1)) + (open-line 1) + (insert new) + + ;; Insert overline. + (when (rst-Hdr-is-over-and-under hdr) + (1value ; Underline inserted above. + (rst-forward-line-strict -1)) (open-line 1) - (insert (make-string len char)) + (insert new)) - (1value ;; Line has been inserted above. - (forward-line +1)) - (goto-char marker))) + (goto-char marker))) -(defun rst-classify-adornment (adornment end) - "Classify adornment for section titles and transitions. +(defun rst-classify-adornment (adornment end &optional accept-over-only) + ;; testcover: ok. + "Classify adornment string for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer with optional trailing whitespace. END is the point after the -last character of ADORNMENT. - -Return a list. The first entry is t for a transition or a -cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for -the meaning of CHARACTER and STYLE. - -The remaining list forms four match groups as returned by -`match-data'. Match group 0 matches the whole construct. Match -group 1 matches the overline adornment if present. Match group 2 -matches the section title text or the transition. Match group 3 -matches the underline adornment. - -Return nil if no syntactically valid adornment is found." +last character of ADORNMENT. Return a `rst-Ttl' or nil if no +syntactically valid adornment is found. If ACCEPT-OVER-ONLY an +overline with a missing underline is accepted as valid and +returned." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) (goto-char end) (let* ((ado-ch (string-to-char (match-string 2 adornment))) - (ado-re (rst-re ado-ch 'adorep3-hlp)) - (end-pnt (point)) + (ado-re (rst-re ado-ch 'adorep3-hlp)) ; RE matching the + ; adornment. (beg-pnt (progn - (1value ;; No lines may be left to move. - (forward-line 0)) + (1value + (rst-forward-line-strict 0)) (point))) (nxt-emp ; Next line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line 1))) - ;; testcover: FIXME: Add test classifying at the end of - ;; buffer. - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at +1 'lin-end #'not))) (prv-emp ; Previous line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line -1))) - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at -1 'lin-end #'not))) + txt-blw (ttl-blw ; Title found below starting here. - (save-excursion - (and - (zerop (forward-line 1)) ;; testcover: FIXME: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re 'ttl-beg)) - (point)))) + (rst-forward-line-looking-at + +1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-blw (match-string-no-properties 1)) + (point))))) + txt-abv (ttl-abv ; Title found above starting here. - (save-excursion - (and - (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg)) - (point)))) + (rst-forward-line-looking-at + -1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-abv (match-string-no-properties 1)) + (point))))) (und-fnd ; Matching underline found starting here. - (save-excursion - (and ttl-blw - (zerop (forward-line 2)) ;; testcover: FIXME: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re ado-re 'lin-end)) - (point)))) + (and ttl-blw + (rst-forward-line-looking-at + +2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) (ovr-fnd ; Matching overline found starting here. - (save-excursion - (and ttl-abv - (zerop (forward-line -2)) - (looking-at (rst-re ado-re 'lin-end)) - (point)))) - key beg-ovr end-ovr beg-txt end-txt beg-und end-und) + (and ttl-abv + (rst-forward-line-looking-at + -2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) + (und-wng ; Wrong underline found starting here. + (and ttl-blw + (not und-fnd) + (rst-forward-line-looking-at + +2 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (point)))))) + (ovr-wng ; Wrong overline found starting here. + (and ttl-abv (not ovr-fnd) + (rst-forward-line-looking-at + -2 'ado-beg-2-1 + #'(lambda (mtcd) + (when (and + mtcd + ;; An adornment above may be a legal + ;; adornment for the line above - consider it + ;; a wrong overline only when it is equally + ;; long. + (equal + (length (match-string-no-properties 1)) + (length adornment))) + (point))))))) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq key t - beg-txt beg-pnt - end-txt end-pnt)) - ((or und-fnd ovr-fnd) + (rst-Ttl-from-buffer (rst-Ado-new-transition) + nil beg-pnt nil nil)) + (ovr-fnd ; Prefer overline match over underline match. + ;; An overline with an underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + ovr-fnd ttl-abv beg-pnt txt-abv)) + (und-fnd ;; An overline with an underline. - (setq key (cons ado-ch 'over-and-under)) - (let (;; Prefer overline match over underline match. - (und-pnt (if ovr-fnd beg-pnt und-fnd)) - (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) - (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) - (goto-char ovr-pnt) - (setq beg-ovr (point) - end-ovr (line-end-position)) - (goto-char txt-pnt) - (setq beg-txt (point) - end-txt (line-end-position)) - (goto-char und-pnt) - (setq beg-und (point) - end-und (line-end-position)))) - (ttl-abv + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw und-fnd txt-blw)) + ((and ttl-abv (not ovr-wng)) ;; An underline. - (setq key (cons ado-ch 'simple) - beg-und beg-pnt - end-und end-pnt) - (goto-char ttl-abv) - (setq beg-txt (point) - end-txt (line-end-position))) + (rst-Ttl-from-buffer (rst-Ado-new-simple ado-ch) + nil ttl-abv beg-pnt txt-abv)) + ((and accept-over-only ttl-blw (not und-wng)) + ;; An overline with a missing underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw nil txt-blw)) (t ;; Invalid adornment. - (setq key nil))) - (if key - (list key - (or beg-ovr beg-txt) - (or end-und end-txt) - beg-ovr end-ovr beg-txt end-txt beg-und end-und))))))) - -(defun rst-find-title-line () + nil))))))) + +(defun rst-ttl-at-point () + ;; testcover: ok. "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title line. If the point is on an empty line check previous or next line whether it is a suitable title line and use it if so. If -point is on a suitable title line use it. - -If no title line is found return nil. - -Otherwise return as `rst-classify-adornment' does. However, if -the title line has no syntactically valid adornment, STYLE is nil -in the first element. If there is no adornment around the title, -CHARACTER is also nil and match groups for overline and underline -are nil." +point is on a suitable title line use it. Return a `rst-Ttl' for +a section header or nil if no title line is found." (save-excursion - (1value ;; No lines may be left to move. - (forward-line 0)) - (let ((orig-pnt (point)) - (orig-end (line-end-position))) - (cond - ((looking-at (rst-re 'ado-beg-2-1)) - (let ((char (string-to-char (match-string-no-properties 2))) - (r (rst-classify-adornment (match-string-no-properties 0) - (match-end 0)))) - (cond - ((not r) - ;; Invalid adornment - check whether this is an incomplete overline. - (if (and - (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons char nil) orig-pnt (line-end-position) - orig-pnt orig-end (point) (line-end-position) nil nil))) - ((consp (car r)) - ;; A section title - not a transition. - r)))) - ((looking-at (rst-re 'lin-end)) - (or - (save-excursion - (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))) - (save-excursion - (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))))) - ((looking-at (rst-re 'ttl-beg)) - ;; Try to use the underline. - (let ((r (rst-classify-adornment - (buffer-substring-no-properties - (line-beginning-position 2) (line-end-position 2)) - (line-end-position 2)))) - (if r - r - ;; No valid adornment found. - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil)))))))) + (save-match-data + (1value + (rst-forward-line-strict 0)) + (let* (cnd-beg ; Beginning of a title candidate. + cnd-txt ; Text of a title candidate. + (cnd-fun #'(lambda (mtcd) ; Function setting title candidate data. + (when mtcd + (setq cnd-beg (match-beginning 0)) + (setq cnd-txt (match-string-no-properties 1)) + t))) + ttl) + (cond + ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. + (setq ttl (rst-classify-adornment (match-string-no-properties 0) + (match-end 0) t))) + ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. + (or + (rst-forward-line-looking-at -1 'ttl-beg-1 cnd-fun) + (rst-forward-line-looking-at +1 'ttl-beg-1 cnd-fun))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (setq ttl (rst-forward-line-looking-at + 1 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (rst-classify-adornment + (match-string-no-properties 0) (match-end 0)))))) + ;; Title candidate found if no valid adornment found. + (funcall cnd-fun (not ttl)))) + (cond + ((and ttl (rst-Ttl-is-section ttl)) + ttl) + (cnd-beg + (rst-Ttl-from-buffer nil nil cnd-beg nil cnd-txt))))))) ;; The following function and variables are used to maintain information about ;; current section adornment in a buffer local cache. Thus they can be used for ;; font-locking and manipulation commands. -(defvar rst-all-sections nil - "All section adornments in the buffer as found by `rst-find-all-adornments'. +(defvar-local rst-all-ttls-cache nil + "All section adornments in the buffer as found by `rst-all-ttls'. Set to t when no section adornments were found.") -(make-variable-buffer-local 'rst-all-sections) ;; FIXME: If this variable is set to a different value font-locking of section ;; headers is wrong. -(defvar rst-section-hierarchy nil - "Section hierarchy in the buffer as determined by `rst-get-hierarchy'. +(defvar-local rst-hdr-hierarchy-cache nil + "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. Set to t when no section adornments were found. -Value depends on `rst-all-sections'.") -(make-variable-buffer-local 'rst-section-hierarchy) +Value depends on `rst-all-ttls-cache'.") (rst-testcover-add-1value 'rst-reset-section-caches) (defun rst-reset-section-caches () "Reset all section cache variables. Should be called by interactive functions which deal with sections." - (setq rst-all-sections nil - rst-section-hierarchy nil)) + (setq rst-all-ttls-cache nil + rst-hdr-hierarchy-cache nil)) -(defun rst-find-all-adornments () - "Return all the section adornments in the current buffer. -Return a list of (LINE . ADORNMENT) with ascending LINE where -LINE is the line containing the section title. ADORNMENT consists -of a (CHARACTER STYLE INDENT) triple as described for -`rst-preferred-adornments'. - -Uses and sets `rst-all-sections'." - (unless rst-all-sections - (let (positions) - ;; Iterate over all the section titles/adornments in the file. - (save-excursion +(defun rst-all-ttls-compute () + ;; testcover: ok. + "Return a list of `rst-Ttl' for current buffer with ascending line number." + (save-excursion + (save-match-data + (let (ttls) (goto-char (point-min)) + ;; Iterate over all the section titles/adornments in the file. (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) - (let ((ado-data (rst-classify-adornment - (match-string-no-properties 0) (point)))) - (when (and ado-data - (consp (car ado-data))) ; Ignore transitions. - (set-match-data (cdr ado-data)) - (goto-char (match-beginning 2)) ; Goto the title start. - (push (cons (1+ (count-lines (point-min) (point))) - (list (caar ado-data) - (cdar ado-data) - (current-indentation))) - positions) - (goto-char (match-end 0))))) ; Go beyond the whole thing. - (setq positions (nreverse positions)) - (setq rst-all-sections (or positions t))))) - (if (eq rst-all-sections t) + (let ((ttl (rst-classify-adornment + (match-string-no-properties 0) (point)))) + (when (and ttl (rst-Ttl-is-section ttl)) + (when (rst-Ttl-hdr ttl) + (push ttl ttls)) + (goto-char (rst-Ttl-get-end ttl))))) + (nreverse ttls))))) + +(defun rst-all-ttls () + "Return all the section adornments in the current buffer. +Return a list of `rst-Ttl' with ascending line number. + +Uses and sets `rst-all-ttls-cache'." + (unless rst-all-ttls-cache + (setq rst-all-ttls-cache (or (rst-all-ttls-compute) t))) + (if (eq rst-all-ttls-cache t) nil - rst-all-sections)) - -(defun rst-infer-hierarchy (adornments) - "Build a hierarchy of adornments using the list of given ADORNMENTS. - -ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment -specifications, in order that they appear in a file, and will -infer a hierarchy of section levels by removing adornments that -have already been seen in a forward traversal of the adornments, -comparing just CHARACTER and STYLE. - -Similarly returns a list of (CHARACTER STYLE INDENT), where each -list element should be unique." - (let (hierarchy-alist) - (dolist (x adornments) - (let ((char (car x)) - (style (cadr x))) - (unless (assoc (cons char style) hierarchy-alist) - (push (cons (cons char style) x) hierarchy-alist)))) - (mapcar 'cdr (nreverse hierarchy-alist)))) - -(defun rst-get-hierarchy (&optional ignore) - "Return the hierarchy of section titles in the file. - -Return a list of adornments that represents the hierarchy of -section titles in the file. Each element consists of (CHARACTER -STYLE INDENT) as described for `rst-find-all-adornments'. If the -line number in IGNORE is specified, a possibly adornment found on -that line is not taken into account when building the hierarchy. - -Uses and sets `rst-section-hierarchy' unless IGNORE is given." - (if (and (not ignore) rst-section-hierarchy) - (if (eq rst-section-hierarchy t) - nil - rst-section-hierarchy) - (let ((r (rst-infer-hierarchy - (mapcar 'cdr - (assq-delete-all - ignore - (rst-find-all-adornments)))))) - (setq rst-section-hierarchy - (if ignore - ;; Clear cache reflecting that a possible update is not - ;; reflected. - nil - (or r t))) - r))) - -(defun rst-get-adornments-around () - "Return the adornments around point. -Return a list of the previous and next adornments." - (let* ((all (rst-find-all-adornments)) - (curline (line-number-at-pos)) - prev next - (cur all)) - - ;; Search for the adornments around the current line. - (while (and cur (< (caar cur) curline)) - (setq prev cur - cur (cdr cur))) - ;; 'cur' is the following adornment. - - (if (and cur (caar cur)) - (setq next (if (= curline (caar cur)) (cdr cur) cur))) - - (mapcar 'cdar (list prev next)))) - -(defun rst-adornment-complete-p (ado) - "Return true if the adornment ADO around point is complete." + (copy-sequence rst-all-ttls-cache))) + +(defun rst-infer-hdr-hierarchy (hdrs) + ;; testcover: ok. + "Build a hierarchy from HDRS. +HDRS reflects the order in which the headers appear in the +buffer. Return a `rst-Hdr' list representing the hierarchy of +headers in the buffer. Indentation is unified." + (let (ado2indents) ; Associates `rst-Ado' with the set of indents seen for it. + (dolist (hdr hdrs) + (let* ((ado (rst-Hdr-ado hdr)) + (indent (rst-Hdr-indent hdr)) + (found (assoc ado ado2indents))) + (if found + (setcdr found (cl-adjoin indent (cdr found))) + (push (list ado indent) ado2indents)))) + (mapcar (cl-function + (lambda ((ado consistent &rest inconsistent)) + (rst-Hdr-new ado (if inconsistent + rst-default-indent + consistent)))) + (nreverse ado2indents)))) + +(defun rst-hdr-hierarchy (&optional ignore-position) + ;; testcover: ok. + "Return the hierarchy of section titles in the file as a `rst-Hdr' list. +Each returned element may be used directly to create a section +adornment on that level. If IGNORE-POSITION a title containing +this position is not taken into account when building the +hierarchy unless it appears again elsewhere. This catches cases +where the current title is edited and may not be final regarding +its level. + +Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-POSITION is +given." + (let* ((all-ttls (rst-all-ttls)) + (ignore-ttl + (if ignore-position + (cl-find-if + #'(lambda (ttl) + (equal (rst-Ttl-contains ttl ignore-position) 0)) + all-ttls))) + (really-ignore + (if ignore-ttl + (<= (cl-count-if + #'(lambda (ttl) + (rst-Ado-equal (rst-Ttl-ado ignore-ttl) + (rst-Ttl-ado ttl))) + all-ttls) + 1))) + (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) + (copy-sequence ; Protect cache. + (if (and (not ignore-position) rst-hdr-hierarchy-cache) + (if (eq rst-hdr-hierarchy-cache t) + nil + rst-hdr-hierarchy-cache) + (let ((r (rst-infer-hdr-hierarchy (mapcar #'rst-Ttl-hdr real-ttls)))) + (setq rst-hdr-hierarchy-cache + (if ignore-position + ;; Clear cache reflecting that a possible update is not + ;; reflected. + nil + (or r t))) + r))))) + +(defun rst-all-ttls-with-level () + ;; testcover: ok. + "Return the section adornments with levels set according to hierarchy. +Return a list of (`rst-Ttl' . LEVEL) with ascending line number." + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (mapcar + #'(lambda (ttl) + (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier))) + (rst-all-ttls)))) + +(defun rst-get-previous-hdr () + "Return the `rst-Hdr' before point or nil if none." + (let ((prev (cl-find-if #'(lambda (ttl) + (< (rst-Ttl-contains ttl (point)) 0)) + (rst-all-ttls) + :from-end t))) + (and prev (rst-Ttl-hdr prev)))) + +(defun rst-adornment-complete-p (ado indent) + ;; testcover: ok. + "Return t if the adornment ADO around point is complete using INDENT. +The adornment is complete if it is a completely correct +reStructuredText adornment for the title line at point. This +includes indentation and correct length of adornment lines." ;; Note: we assume that the detection of the overline as being the underline ;; of a preceding title has already been detected, and has been eliminated ;; from the adornment that is given to us. - - ;; There is some sectioning already present, so check if the current - ;; sectioning is complete and correct. - (let* ((char (car ado)) - (style (cadr ado)) - (indent (caddr ado)) - (endcol (save-excursion (end-of-line) (current-column)))) - (if char - (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$"))) - (and - (save-excursion (forward-line +1) - (beginning-of-line) - (looking-at exps)) - (or (not (eq style 'over-and-under)) - (save-excursion (forward-line -1) - (beginning-of-line) - (looking-at exps)))))))) - - -(defun rst-get-next-adornment - (curado hier &optional suggestion reverse-direction) - "Get the next adornment for CURADO, in given hierarchy HIER. -If suggesting, suggest for new adornment SUGGESTION. -REVERSE-DIRECTION is used to reverse the cycling order." - - (let* ( - (char (car curado)) - (style (cadr curado)) - - ;; Build a new list of adornments for the rotation. - (rotados - (append hier - ;; Suggest a new adornment. - (list suggestion - ;; If nothing to suggest, use first adornment. - (car hier)))) ) + (let ((exps (list "^" (rst-Ado-char ado) + (format "\\{%d\\}" + (+ (save-excursion + ;; Determine last column of title. + (end-of-line) + (current-column)) + indent)) "$"))) + (and (rst-forward-line-looking-at +1 exps) + (or (rst-Ado-is-simple ado) + (rst-forward-line-looking-at -1 exps)) + t))) ; Normalize return value. + +(defun rst-next-hdr (hdr hier prev down) + ;; testcover: ok. + "Return the next best `rst-Hdr' upward from HDR. +Consider existing hierarchy HIER and preferred headers. PREV may +be a previous `rst-Hdr' which may be taken into account. If DOWN +return the next best `rst-Hdr' downward instead. Return nil in +HIER is nil." + (let* ((normalized-hier (if down + hier + (reverse hier))) + (fnd (rst-Hdr-member-ado hdr normalized-hier)) + (prev-fnd (and prev (rst-Hdr-member-ado prev normalized-hier)))) (or - ;; Search for next adornment. - (cadr - (let ((cur (if reverse-direction rotados - (reverse rotados)))) - (while (and cur - (not (and (eq char (caar cur)) - (eq style (cadar cur))))) - (setq cur (cdr cur))) - cur)) - - ;; If not found, take the first of all adornments. - suggestion))) - + ;; Next entry in existing hierarchy if it exists. + (cadr fnd) + (if fnd + ;; If current header is found try introducing a new one from preferred + ;; hierarchy. + (rst-new-preferred-hdr hier prev) + ;; If not found try using previous header. + (if down + (cadr prev-fnd) + (car prev-fnd))) + ;; All failed - rotate by using first from normalized existing hierarchy. + (car normalized-hier)))) ;; FIXME: A line "``/`` full" is not accepted as a section title. (defun rst-adjust (pfxarg) + ;; testcover: ok. "Auto-adjust the adornment around point. - Adjust/rotate the section adornment for the section title around point or promote/demote the adornments inside the region, depending on whether the region is active. This function is meant @@ -1516,11 +1983,8 @@ the adornments of a section title in reStructuredText. It tries to deal with all the possible cases gracefully and to do \"the right thing\" in all cases. -See the documentations of `rst-adjust-adornment-work' and -`rst-promote-region' for full details. - -Prefix Arguments -================ +See the documentations of `rst-adjust-section' and +`rst-adjust-region' for full details. The method can take either (but not both) of @@ -1531,24 +1995,18 @@ b. a negative numerical argument, which generally inverts the direction of search in the file or hierarchy. Invoke with C-- prefix for example." (interactive "P") - - (let* (;; Save our original position on the current line. - (origpt (point-marker)) - + (let* ((origpt (point-marker)) (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) (toggle-style (and pfxarg (not reverse-direction)))) - (if (use-region-p) - ;; Adjust adornments within region. - (rst-promote-region (and pfxarg t)) - ;; Adjust adornment around point. - (rst-adjust-adornment-work toggle-style reverse-direction)) - - ;; Run the hooks to run after adjusting. + (rst-adjust-region (and pfxarg t)) + (let ((msg (rst-adjust-section toggle-style reverse-direction))) + (when msg + (apply #'message msg)))) (run-hooks 'rst-adjust-hook) - - ;; Make sure to reset the cursor position properly after we're done. - (goto-char origpt))) + (rst-reset-section-caches) + (set-marker + (goto-char origpt) nil))) (defcustom rst-adjust-hook nil "Hooks to be run after running `rst-adjust'." @@ -1567,31 +2025,92 @@ b. a negative numerical argument, which generally inverts the (rst-testcover-defcustom) (defun rst-adjust-adornment (pfxarg) - "Call `rst-adjust-adornment-work' interactively. - + "Call `rst-adjust-section' interactively. Keep this for compatibility for older bindings (are there any?). Argument PFXARG has the same meaning as for `rst-adjust'." (interactive "P") (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) (toggle-style (and pfxarg (not reverse-direction)))) - (rst-adjust-adornment-work toggle-style reverse-direction))) - -(defun rst-adjust-adornment-work (toggle-style reverse-direction) -"Adjust/rotate the section adornment for the section title around point. - -This function is meant to be invoked possibly multiple times, and -can vary its behavior with a true TOGGLE-STYLE argument, or with -a REVERSE-DIRECTION argument. - -General Behavior -================ - -The next action it takes depends on context around the point, and -it is meant to be invoked possibly more than once to rotate among -the various possibilities. Basically, this function deals with: - -- adding a adornment if the title does not have one; + (rst-adjust-section toggle-style reverse-direction))) + +(defun rst-adjust-new-hdr (toggle-style reverse ttl) + ;; testcover: ok. + "Return a new `rst-Hdr' for `rst-adjust-section' related to TTL. +TOGGLE-STYLE and REVERSE are from +`rst-adjust-section'. TOGGLE-STYLE may be consumed and thus is +returned. + +Return a list (HDR TOGGLE-STYLE MSG...). HDR is the result or +nil. TOGGLE-STYLE is the new TOGGLE-STYLE to use in the +caller. MSG is a list which is non-empty in case HDR is nil +giving an argument list for `message'." + (save-excursion + (goto-char (rst-Ttl-get-title-beginning ttl)) + (let ((indent (rst-Ttl-indent ttl)) + (ado (rst-Ttl-ado ttl)) + (prev (rst-get-previous-hdr)) + hdr-msg) + (setq + hdr-msg + (cond + ((rst-Ttl-is-candidate ttl) + ;; Case 1: No adornment at all. + (let ((hier (rst-hdr-hierarchy))) + (if prev + ;; Previous header exists - use it. + (cond + ;; Customization and parameters require that the previous level + ;; is used - use it as is. + ((or (and rst-new-adornment-down reverse) + (and (not rst-new-adornment-down) (not reverse))) + prev) + ;; Advance one level down. + ((rst-next-hdr prev hier prev t)) + ("Neither hierarchy nor preferences can suggest a deeper header")) + ;; First header in the buffer - use the first adornment from + ;; preferences or hierarchy. + (let ((p (car (rst-Hdr-preferred-adornments))) + (h (car hier))) + (cond + ((if reverse + ;; Prefer hierarchy for downwards + (or h p) + ;; Prefer preferences for upwards + (or p h))) + ("No preferences to suggest a top level from")))))) + ((not (rst-adornment-complete-p ado indent)) + ;; Case 2: Incomplete adornment. + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent)) + ;; Case 3: Complete adornment exists from here on. + (toggle-style + ;; Simply switch the style of the current adornment. + (setq toggle-style nil) ; Remember toggling has been done. + (rst-Hdr-new-invert ado rst-default-indent)) + (t + ;; Rotate, ignoring a sole adornment around the current line. + (let ((hier (rst-hdr-hierarchy (point)))) + (cond + ;; Next header can be determined from hierarchy or preferences. + ((rst-next-hdr + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent) hier prev reverse)) + ;; No next header found. + ("No preferences or hierarchy to suggest another level from")))))) + (if (stringp hdr-msg) + (list nil toggle-style hdr-msg) + (list hdr-msg toggle-style))))) + +(defun rst-adjust-section (toggle-style reverse) + ;; testcover: ok. + "Adjust/rotate the section adornment for the section title around point. +The action this function takes depends on context around the +point, and it is meant to be invoked possibly more than once to +rotate among the various possibilities. Basically, this function +deals with: + +- adding an adornment if the title does not have one; - adjusting the length of the underline characters to fit a modified title; @@ -1599,319 +2118,182 @@ the various possibilities. Basically, this function deals with: - rotating the adornment in the set of already existing sectioning adornments used in the file; -- switching between simple and over-and-under styles. - -You should normally not have to read all the following, just -invoke the method and it will do the most obvious thing that you -would expect. - - -Adornment Definitions -===================== - -The adornments consist in - -1. a CHARACTER - -2. a STYLE which can be either `simple' or `over-and-under'. - -3. an INDENT (meaningful for the over-and-under style only) - which determines how many characters and over-and-under - style is hanging outside of the title at the beginning and - ending. - -See source code for mode details. - - -Detailed Behavior Description -============================= - -Here are the gory details of the algorithm (it seems quite -complicated, but really, it does the most obvious thing in all -the particular cases): - -Before applying the adornment change, the cursor is placed on -the closest line that could contain a section title. - -Case 1: No Adornment --------------------- - -If the current line has no adornment around it, - -- search backwards for the last previous adornment, and apply - the adornment one level lower to the current line. If there - is no defined level below this previous adornment, we suggest - the most appropriate of the `rst-preferred-adornments'. +- switching between simple and over-and-under styles by giving + TOGGLE-STYLE. - If REVERSE-DIRECTION is true, we simply use the previous - adornment found directly. +Return nil if the function did something. If the function were +not able to do something return an argument list for `message' to +inform the user about what failed. -- if there is no adornment found in the given direction, we use - the first of `rst-preferred-adornments'. +The following is a detailed description but you should normally +not have to read it. -TOGGLE-STYLE forces a toggle of the prescribed adornment style. +Before applying the adornment change, the cursor is placed on the +closest line that could contain a section title if such is found +around the cursor. Then the following cases are distinguished. -Case 2: Incomplete Adornment ----------------------------- +* Case 1: No Adornment -If the current line does have an existing adornment, but the -adornment is incomplete, that is, the underline/overline does -not extend to exactly the end of the title line (it is either -too short or too long), we simply extend the length of the -underlines/overlines to fit exactly the section title. + If the current line has no adornment around it, -If TOGGLE-STYLE we toggle the style of the adornment as well. + - search for a previous adornment, and apply this adornment (unless + `rst-new-adornment-down') or one level lower (otherwise) to the current + line. If there is no defined level below this previous adornment, we + suggest the most appropriate of the `rst-preferred-adornments'. -REVERSE-DIRECTION has no effect in this case. + If REVERSE is true, we simply use the previous adornment found + directly. -Case 3: Complete Existing Adornment ------------------------------------ + - if there is no adornment found in the given direction, we use the first of + `rst-preferred-adornments'. -If the adornment is complete (i.e. the underline (overline) -length is already adjusted to the end of the title line), we -search/parse the file to establish the hierarchy of all the -adornments (making sure not to include the adornment around -point), and we rotate the current title's adornment from within -that list (by default, going *down* the hierarchy that is present -in the file, i.e. to a lower section level). This is meant to be -used potentially multiple times, until the desired adornment is -found around the title. + TOGGLE-STYLE forces a toggle of the prescribed adornment style. -If we hit the boundary of the hierarchy, exactly one choice from -the list of preferred adornments is suggested/chosen, the first -of those adornment that has not been seen in the file yet (and -not including the adornment around point), and the next -invocation rolls over to the other end of the hierarchy (i.e. it -cycles). This allows you to avoid having to set which character -to use. +* Case 2: Incomplete Adornment -If REVERSE-DIRECTION is true, the effect is to change the -direction of rotation in the hierarchy of adornments, thus -instead going *up* the hierarchy. + If the current line does have an existing adornment, but the adornment is + incomplete, that is, the underline/overline does not extend to exactly the + end of the title line (it is either too short or too long), we simply extend + the length of the underlines/overlines to fit exactly the section title. -However, if TOGGLE-STYLE, we do not rotate the adornment, but -instead simply toggle the style of the current adornment (this -should be the most common way to toggle the style of an existing -complete adornment). + If TOGGLE-STYLE we toggle the style of the adornment as well. + REVERSE has no effect in this case. -Point Location -============== +* Case 3: Complete Existing Adornment -The invocation of this function can be carried out anywhere -within the section title line, on an existing underline or -overline, as well as on an empty line following a section title. -This is meant to be as convenient as possible. + If the adornment is complete (i.e. the underline (overline) length is already + adjusted to the end of the title line), we rotate the current title's + adornment according to the adornment hierarchy found in the buffer. This is + meant to be used potentially multiple times, until the desired adornment is + found around the title. + If we hit the boundary of the hierarchy, exactly one choice from the list of + preferred adornments is suggested/chosen, the first of those adornment that + has not been seen in the buffer yet, and the next invocation rolls over to + the other end of the hierarchy (i.e. it cycles). -Indented Sections -================= + If REVERSE is we go up in the hierarchy. Otherwise we go down. -Indented section titles such as :: - - My Title - -------- - -are invalid in reStructuredText and thus not recognized by the -parser. This code will thus not work in a way that would support -indented sections (it would be ambiguous anyway). - - -Joint Sections -============== - -Section titles that are right next to each other may not be -treated well. More work might be needed to support those, and -special conditions on the completeness of existing adornments -might be required to make it non-ambiguous. - -For now we assume that the adornments are disjoint, that is, -there is at least a single line between the titles/adornment -lines." + However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply + toggle the style of the current adornment." (rst-reset-section-caches) - (let ((ttl-fnd (rst-find-title-line)) - (orig-pnt (point))) - (when ttl-fnd - (set-match-data (cdr ttl-fnd)) - (goto-char (match-beginning 2)) - (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) - (char (caar ttl-fnd)) - (style (cdar ttl-fnd)) - (indent (current-indentation)) - (curado (list char style indent)) - char-new style-new indent-new) - (cond - ;;------------------------------------------------------------------- - ;; Case 1: No valid adornment - ((not style) - (let ((prev (car (rst-get-adornments-around))) - cur - (hier (rst-get-hierarchy))) - ;; Advance one level down. - (setq cur - (if prev - (if (or (and rst-new-adornment-down reverse-direction) - (and (not rst-new-adornment-down) - (not reverse-direction))) - prev - (or (cadr (rst-get-adornment-match hier prev)) - (rst-suggest-new-adornment hier prev))) - (copy-sequence (car rst-preferred-adornments)))) - ;; Invert the style if requested. - (if toggle-style - (setcar (cdr cur) (if (eq (cadr cur) 'simple) - 'over-and-under 'simple)) ) - (setq char-new (car cur) - style-new (cadr cur) - indent-new (caddr cur)))) - ;;------------------------------------------------------------------- - ;; Case 2: Incomplete Adornment - ((not (rst-adornment-complete-p curado)) - ;; Invert the style if requested. - (if toggle-style - (setq style (if (eq style 'simple) 'over-and-under 'simple))) - (setq char-new char - style-new style - indent-new indent)) - ;;------------------------------------------------------------------- - ;; Case 3: Complete Existing Adornment - (t - (if toggle-style - ;; Simply switch the style of the current adornment. - (setq char-new char - style-new (if (eq style 'simple) 'over-and-under 'simple) - indent-new rst-default-indent) - ;; Else, we rotate, ignoring the adornment around the current - ;; line... - (let* ((hier (rst-get-hierarchy (line-number-at-pos))) - ;; Suggestion, in case we need to come up with something new. - (suggestion (rst-suggest-new-adornment - hier - (car (rst-get-adornments-around)))) - (nextado (rst-get-next-adornment - curado hier suggestion reverse-direction))) - ;; Indent, if present, always overrides the prescribed indent. - (setq char-new (car nextado) - style-new (cadr nextado) - indent-new (caddr nextado)))))) - ;; Override indent with present indent! - (setq indent-new (if (> indent 0) indent indent-new)) - (if (and char-new style-new) - (rst-update-section char-new style-new indent-new)) - ;; Correct the position of the cursor to more accurately reflect where - ;; it was located when the function was invoked. - (unless (zerop moved) - (forward-line (- moved)) - (end-of-line)))))) + (let ((ttl (rst-ttl-at-point))) + (if (not ttl) + '("No section header or candidate at point") + (cl-destructuring-bind + (hdr toggle-style &rest msg + &aux + (indent (rst-Ttl-indent ttl)) + (moved (- (line-number-at-pos (rst-Ttl-get-title-beginning ttl)) + (line-number-at-pos)))) + (rst-adjust-new-hdr toggle-style reverse ttl) + (if msg + msg + (when toggle-style + (setq hdr (rst-Hdr-new-invert (rst-Hdr-ado hdr) indent))) + ;; Override indent with present indent if there is some. + (when (> indent 0) + ;; Use lax since existing indent may not be valid for new style. + (setq hdr (rst-Hdr-new-lax (rst-Hdr-ado hdr) indent))) + (goto-char (rst-Ttl-get-title-beginning ttl)) + (rst-update-section hdr) + ;; Correct the position of the cursor to more accurately reflect + ;; where it was located when the function was invoked. + (unless (zerop moved) + (1value ; No lines may be left to move. + (rst-forward-line-strict (- moved))) + (end-of-line)) + nil))))) ;; Maintain an alias for compatibility. (defalias 'rst-adjust-section-title 'rst-adjust) - -(defun rst-promote-region (demote) +(defun rst-adjust-region (demote) + ;; testcover: ok. "Promote the section titles within the region. - With argument DEMOTE or a prefix argument, demote the section titles instead. The algorithm used at the boundaries of the -hierarchy is similar to that used by `rst-adjust-adornment-work'." +hierarchy is similar to that used by `rst-adjust-section'." (interactive "P") (rst-reset-section-caches) - (let* ((cur (rst-find-all-adornments)) - (hier (rst-get-hierarchy)) - (suggestion (rst-suggest-new-adornment hier)) - - (region-begin-line (line-number-at-pos (region-beginning))) - (region-end-line (line-number-at-pos (region-end))) - - marker-list) - - ;; Skip the markers that come before the region beginning. - (while (and cur (< (caar cur) region-begin-line)) - (setq cur (cdr cur))) - - ;; Create a list of markers for all the adornments which are found within - ;; the region. + (let* ((beg (region-beginning)) + (end (region-end)) + (ttls-reg (cl-remove-if-not + #'(lambda (ttl) + (and + (>= (rst-Ttl-contains ttl beg) 0) + (< (rst-Ttl-contains ttl end) 0))) + (rst-all-ttls)))) (save-excursion - (let (line) - (while (and cur (< (setq line (caar cur)) region-end-line)) - (goto-char (point-min)) - (forward-line (1- line)) - (push (list (point-marker) (cdar cur)) marker-list) - (setq cur (cdr cur)) )) - ;; Apply modifications. - (dolist (p marker-list) - ;; Go to the adornment to promote. - (goto-char (car p)) - - ;; Update the adornment. - (apply 'rst-update-section - ;; Rotate the next adornment. - (rst-get-next-adornment - (cadr p) hier suggestion demote)) - - ;; Clear marker to avoid slowing down the editing after we're done. - (set-marker (car p) nil)) + (rst-destructuring-dolist + ((marker &rest hdr + &aux (hier (rst-hdr-hierarchy))) + (mapcar #'(lambda (ttl) + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) + (rst-Ttl-hdr ttl))) + ttls-reg)) + (set-marker + (goto-char marker) nil) + ;; `rst-next-hdr' cannot return nil because we apply to a section + ;; header so there is some hierarchy. + (rst-update-section (rst-next-hdr hdr hier nil demote))) (setq deactivate-mark nil)))) - - -(defun rst-display-adornments-hierarchy (&optional adornments) +(defun rst-display-hdr-hierarchy () + ;; testcover: ok. "Display the current file's section title adornments hierarchy. -This function expects a list of (CHARACTER STYLE INDENT) triples -in ADORNMENTS." +Hierarchy is displayed in a temporary buffer." (interactive) (rst-reset-section-caches) - (if (not adornments) - (setq adornments (rst-get-hierarchy))) - (with-output-to-temp-buffer "*rest section hierarchy*" - (let ((level 1)) + (let ((hdrs (rst-hdr-hierarchy)) + (level 1)) + (with-output-to-temp-buffer "*rest section hierarchy*" (with-current-buffer standard-output - (dolist (x adornments) - (insert (format "\nSection Level %d" level)) - (apply 'rst-update-section x) - (goto-char (point-max)) - (insert "\n") - (incf level)))))) - -(defun rst-straighten-adornments () - "Redo all the adornments in the current buffer. -This is done using our preferred set of adornments. This can be + (dolist (hdr hdrs) + (insert (format "\nSection Level %d" level)) + (rst-update-section hdr) + (goto-char (point-max)) + (insert "\n") + (cl-incf level)))))) + +;; Maintain an alias for backward compatibility. +(defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) + +;; FIXME: Should accept an argument giving the hierarchy level to start with +;; instead of the top of the hierarchy. +(defun rst-straighten-sections () + ;; testcover: ok. + "Redo the adornments of all section titles in the current buffer. +This is done using the preferred set of adornments. This can be used, for example, when using somebody else's copy of a document, in order to adapt it to our preferred style." (interactive) (rst-reset-section-caches) (save-excursion - (let (;; Get a list of pairs of (level . marker). - (levels-and-markers (mapcar - (lambda (ado) - (cons (rst-position (cdr ado) - (rst-get-hierarchy)) - (progn - (goto-char (point-min)) - (forward-line (1- (car ado))) - (point-marker)))) - (rst-find-all-adornments)))) - (dolist (lm levels-and-markers) - ;; Go to the appropriate position. - (goto-char (cdr lm)) - - ;; Apply the new style. - (apply 'rst-update-section (nth (car lm) rst-preferred-adornments)) - - ;; Reset the marker to avoid slowing down editing until it gets GC'ed. - (set-marker (cdr lm) nil))))) + (rst-destructuring-dolist + ((marker &rest level) + (mapcar + (cl-function + (lambda ((ttl &rest level)) + ;; Use markers so edits don't disturb the position. + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) level))) + (rst-all-ttls-with-level))) + (set-marker + (goto-char marker) nil) + (rst-update-section (nth level (rst-Hdr-preferred-adornments)))))) + +;; Maintain an alias for compatibility. +(defalias 'rst-straighten-adornments 'rst-straighten-sections) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Insert list items -;; ================= - -;================================================= -; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. -; I needed to make some tiny changes to the functions, so I put it here. -; -- Wei-Wei Guo +;; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. I +;; needed to make some tiny changes to the functions, so I put it here. +;; -- Wei-Wei Guo (defconst rst-arabic-to-roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") @@ -1920,72 +2302,59 @@ in order to adapt it to our preferred style." (1 . "I")) "List of maps between Arabic numbers and their Roman numeral equivalents.") -(defun rst-arabic-to-roman (num &optional arg) +(defun rst-arabic-to-roman (num) + ;; testcover: ok. "Convert Arabic number NUM to its Roman numeral representation. Obviously, NUM must be greater than zero. Don't blame me, blame the Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with -apologies to Monty Python). -If optional ARG is non-nil, insert in current buffer." +apologies to Monty Python)." + (cl-check-type num (integer 1 *)) (let ((map rst-arabic-to-roman) - res) + (r "")) (while (and map (> num 0)) - (if (or (= num (caar map)) - (> num (caar map))) - (setq res (concat res (cdar map)) - num (- num (caar map))) - (setq map (cdr map)))) - (if arg (insert (or res "")) res))) - -(defun rst-roman-to-arabic (string &optional arg) + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (>= num val) + (setq r (concat r sym) + num (- num val)) + (setq map next)))) + r)) + +(defun rst-roman-to-arabic (string) + ;; testcover: ok. "Convert STRING of Roman numerals to an Arabic number. - If STRING contains a letter which isn't a valid Roman numeral, the rest of the string from that point onwards is ignored. - Hence: MMD == 2500 and -MMDFLXXVI == 2500. -If optional ARG is non-nil, insert in current buffer." +MMDFLXXVI == 2500." + (cl-check-type string string) + (cl-check-type string (satisfies (lambda (s) + (not (equal s "")))) + "Roman number may not be an empty string.") (let ((res 0) (map rst-arabic-to-roman)) - (while map - (if (string-match (concat "^" (cdar map)) string) - (setq res (+ res (caar map)) - string (replace-match "" nil t string)) - (setq map (cdr map)))) - (if arg (insert res) res))) -;================================================= - -(defun rst-find-pfx-in-region (beg end pfx-re) - "Find all the positions of prefixes in region between BEG and END. -This is used to find bullets and enumerated list items. PFX-RE is -a regular expression for matching the lines after indentation -with items. Returns a list of cons cells consisting of the point -and the column of the point." - (let ((pfx ())) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (when (and - (looking-at pfx-re) ; pfx found and... - (let ((pfx-col (current-column))) - (save-excursion - (forward-line -1) ; ...previous line is... - (back-to-indentation) - (or (looking-at (rst-re 'lin-end)) ; ...empty, - (> (current-column) pfx-col) ; ...deeper level, or - (and (= (current-column) pfx-col) - (looking-at pfx-re)))))) ; ...pfx at same level. - (push (cons (point) (current-column)) - pfx)) - (forward-line 1))) - (nreverse pfx))) - -(defun rst-insert-list-pos (newitem) - "Arrange relative position of a newly inserted list item of style NEWITEM. + (save-match-data + (while map + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (string-match (concat "^" sym) string) + (setq res (+ res val) + string (replace-match "" nil t string)) + (setq map next)))) + (cl-check-type string (satisfies (lambda (s) + (equal s ""))) + "Invalid characters in roman number") + res))) + +;; End of borrow. + +;; FIXME: All the following code should not consider single lines as items but +;; paragraphs as reST does. + +(defun rst-insert-list-new-tag (tag) + ;; testcover: ok. + "Insert first item of a new list tagged with TAG. Adding a new list might consider three situations: @@ -2001,45 +2370,42 @@ When not (a), first forward point to the end of the line, and add two blank lines, then add the new list. Other situations are just ignored and left to users themselves." - (if (save-excursion - (beginning-of-line) - (looking-at (rst-re 'lin-end))) - (if (save-excursion - (forward-line -1) - (looking-at (rst-re 'lin-end))) - (insert newitem " ") - (insert "\n" newitem " ")) + ;; FIXME: Following line is not considered at all. + (let ((pfx-nls + ;; FIXME: Doesn't work properly for white-space line. See + ;; `rst-insert-list-new-BUGS'. + (if (rst-forward-line-looking-at 0 'lin-end) + (if (not (rst-forward-line-looking-at -1 'lin-end #'not)) + 0 + 1) + 2))) (end-of-line) - (insert "\n\n" newitem " "))) - -;; FIXME: Isn't this a `defconst'? -(defvar rst-initial-enums - (let (vals) - (dolist (fmt '("%s." "(%s)" "%s)")) - (dolist (c '("1" "a" "A" "I" "i")) - (push (format fmt c) vals))) - (cons "#." (nreverse vals))) - "List of initial enumerations.") - -;; FIXME: Isn't this a `defconst'? -(defvar rst-initial-items - (append (mapcar 'char-to-string rst-bullets) rst-initial-enums) + ;; FIXME: The indentation is not fixed to a single space by the syntax. May + ;; be this should be configurable or rather taken from the context. + (insert (make-string pfx-nls ?\n) tag " "))) + +(defconst rst-initial-items + (append (mapcar #'char-to-string rst-bullets) + (let (vals) + (dolist (fmt '("%s." "(%s)" "%s)")) + (dolist (c '("#" "1" "a" "A" "I" "i")) + (push (format fmt c) vals))) + (nreverse vals))) "List of initial items. It's a collection of bullets and enumerations.") (defun rst-insert-list-new-item () + ;; testcover: ok. "Insert a new list item. User is asked to select the item style first, for example (a), i), +. Use TAB for completion and choices. If user selects bullets or #, it's just added with position arranged by -`rst-insert-list-pos'. +`rst-insert-list-new-tag'. If user selects enumerations, a further prompt is given. User need to input a starting item, for example 'e' for 'A)' style. The position is -also arranged by `rst-insert-list-pos'." - (interactive) - ;; FIXME: Make this comply to `interactive' standards. +also arranged by `rst-insert-list-new-tag'." (let* ((itemstyle (completing-read "Select preferred item style [#.]: " rst-initial-items nil t nil nil "#.")) @@ -2047,7 +2413,6 @@ also arranged by `rst-insert-list-pos'." (match-string 0 itemstyle))) (no (save-match-data - ;; FIXME: Make this comply to `interactive' standards. (cond ((equal cnt "a") (let ((itemno (read-string "Give starting value [a]: " @@ -2068,64 +2433,73 @@ also arranged by `rst-insert-list-pos'." (number-to-string itemno))))))) (if no (setq itemstyle (replace-match no t t itemstyle))) - (rst-insert-list-pos itemstyle))) + (rst-insert-list-new-tag itemstyle))) (defcustom rst-preferred-bullets '(?* ?- ?+) "List of favorite bullets." :group 'rst :type `(repeat - (choice ,@(mapcar (lambda (char) - (list 'const - :tag (char-to-string char) char)) + (choice ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) rst-bullets))) :package-version '(rst . "1.1.0")) (rst-testcover-defcustom) -(defun rst-insert-list-continue (curitem prefer-roman) - "Insert a list item with list start CURITEM including its indentation level. -If PREFER-ROMAN roman numbering is preferred over using letters." +(defun rst-insert-list-continue (ind tag tab prefer-roman) + ;; testcover: ok. + "Insert a new list tag after the current line according to style. +Style is defined by indentation IND, TAG and suffix TAB. If +PREFER-ROMAN roman numbering is preferred over using letters." (end-of-line) (insert - "\n" ; FIXME: Separating lines must be possible. - (cond - ((string-match (rst-re '(:alt enmaut-tag - bul-tag)) curitem) - curitem) - ((string-match (rst-re 'num-tag) curitem) - (replace-match (number-to-string - (1+ (string-to-number (match-string 0 curitem)))) - nil nil curitem)) - ((and (string-match (rst-re 'rom-tag) curitem) - (save-match-data - (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag. - (save-excursion - ;; FIXME: Assumes one line list items without separating - ;; empty lines. - (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'enmexp-beg))) - (string-match - (rst-re 'rom-tag) - (match-string 0)) ; Previous was a roman tag. - prefer-roman)) ; Don't know - use flag. - t))) ; Not a letter tag. - (replace-match - (let* ((old (match-string 0 curitem)) - (new (save-match-data - (rst-arabic-to-roman - (1+ (rst-roman-to-arabic - (upcase old))))))) - (if (equal old (upcase old)) - (upcase new) - (downcase new))) - t nil curitem)) - ((string-match (rst-re 'ltr-tag) curitem) - (replace-match (char-to-string - (1+ (string-to-char (match-string 0 curitem)))) - nil nil curitem))))) - - + ;; FIXME: Separating lines must be possible. + "\n" + ind + (save-match-data + (if (not (string-match (rst-re 'cntexp-tag) tag)) + tag + (let ((pfx (substring tag 0 (match-beginning 0))) + (cnt (match-string 0 tag)) + (sfx (substring tag (match-end 0)))) + (concat + pfx + (cond + ((string-match (rst-re 'num-tag) cnt) + (number-to-string (1+ (string-to-number (match-string 0 cnt))))) + ((and + (string-match (rst-re 'rom-tag) cnt) + (save-match-data + (if (string-match (rst-re 'ltr-tag) cnt) ; Also a letter tag. + (save-excursion + ;; FIXME: Assumes one line list items without separating + ;; empty lines. + ;; Use of `rst-forward-line-looking-at' is very difficult + ;; here so don't do it. + (if (and (rst-forward-line-strict -1) + (looking-at (rst-re 'enmexp-beg))) + (string-match + (rst-re 'rom-tag) + (match-string 0)) ; Previous was a roman tag. + prefer-roman)) ; Don't know - use flag. + t))) ; Not a letter tag. + (let* ((old (match-string 0 cnt)) + (new (rst-arabic-to-roman + (1+ (rst-roman-to-arabic (upcase old)))))) + (if (equal old (upcase old)) + (upcase new) + (downcase new)))) + ((string-match (rst-re 'ltr-tag) cnt) + (char-to-string (1+ (string-to-char (match-string 0 cnt)))))) + sfx)))) + tab)) + +;; FIXME: At least the continuation may be folded into +;; `newline-and-indent`. However, this may not be wanted by everyone so +;; it should be possible to switch this off. (defun rst-insert-list (&optional prefer-roman) + ;; testcover: ok. "Insert a list item at the current point. The command can insert a new list or a continuing list. When it is called at a @@ -2153,156 +2527,150 @@ preceded by a blank line, it is hard to determine which type to use automatically. The function uses alphabetical list by default. If you want roman numerical list, just use a prefix to set PREFER-ROMAN." (interactive "P") - (beginning-of-line) - (if (looking-at (rst-re 'itmany-beg-1)) - (rst-insert-list-continue (match-string 0) prefer-roman) - (rst-insert-list-new-item))) + (save-match-data + (1value + (rst-forward-line-strict 0)) + ;; FIXME: Finds only tags in single line items. Multi-line items should be + ;; considered as well. + ;; Using `rst-forward-line-looking-at' is more complicated so don't do it. + (if (looking-at (rst-re 'itmany-beg-1)) + (rst-insert-list-continue + (buffer-substring-no-properties + (match-beginning 0) (match-beginning 1)) + (match-string 1) + (buffer-substring-no-properties (match-end 1) (match-end 0)) + prefer-roman) + (rst-insert-list-new-item)))) + +;; FIXME: This is wrong because it misses prefixed lines without intervening +;; new line. See `rst-straighten-bullets-region-BUGS' and +;; `rst-find-begs-BUGS'. +(defun rst-find-begs (beg end rst-re-beg) + ;; testcover: ok. + "Return the positions of begs in region BEG to END. +RST-RE-BEG is a `rst-re' argument and matched at the beginning of +a line. Return a list of (POINT . COLUMN) where POINT gives the +point after indentation and COLUMN gives its column. The list is +ordered by POINT." + (let (r) + (save-match-data + (save-excursion + ;; FIXME refactoring: Consider making this construct a macro looping + ;; over the lines. + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (let ((clm (current-indentation))) + ;; FIXME refactoring: Consider using `rst-forward-line-looking-at'. + (when (and + (looking-at (rst-re rst-re-beg)) ; Start found + (not (rst-forward-line-looking-at + -1 'lin-end + #'(lambda (mtcd) ; Previous line exists and is... + (and + (not mtcd) ; non-empty, + (<= (current-indentation) clm) ; less indented + (not (and (= (current-indentation) clm) + ; not a beg at same level. + (looking-at (rst-re rst-re-beg))))))))) + (back-to-indentation) + (push (cons (point) clm) r))) + (1value ; At least one line is moved in this loop. + (rst-forward-line-strict 1 end))))) + (nreverse r))) (defun rst-straighten-bullets-region (beg end) - "Make all the bulleted list items in the region consistent. -The region is specified between BEG and END. You can use this -after you have merged multiple bulleted lists to make them use -the same/correct/consistent bullet characters. - -See variable `rst-preferred-bullets' for the list of bullets to -adjust. If bullets are found on levels beyond the -`rst-preferred-bullets' list, they are not modified." + ;; testcover: ok. + "Make all the bulleted list items in the region from BEG to END consistent. +Use this after you have merged multiple bulleted lists to make +them use the preferred bullet characters given by +`rst-preferred-bullets' for each level. If bullets are found on +levels beyond the `rst-preferred-bullets' list, they are not +modified." (interactive "r") - - (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta))) - (levtable (make-hash-table :size 4))) - - ;; Create a map of levels to list of positions. - (dolist (x bullets) - (let ((key (cdr x))) - (puthash key - (append (gethash key levtable (list)) - (list (car x))) - levtable))) - - ;; Sort this map and create a new map of prefix char and list of positions. - (let ((poslist ())) ; List of (indent . positions). - (maphash (lambda (x y) (push (cons x y) poslist)) levtable) - - (let ((bullets rst-preferred-bullets)) - (dolist (x (sort poslist 'car-less-than-car)) - (when bullets - ;; Apply the characters. - (dolist (pos (cdr x)) - (goto-char pos) - (delete-char 1) - (insert (string (car bullets)))) - (setq bullets (cdr bullets)))))))) + (save-excursion + (let (clm2pnts) ; Map a column to a list of points at this column. + (rst-destructuring-dolist + ((point &rest column + &aux (found (assoc column clm2pnts))) + (rst-find-begs beg end 'bul-beg)) + (if found + ;;; (push point (cdr found)) ; FIXME: Doesn't work with `testcover'. + (setcdr found (cons point (cdr found))) ; Synonym. + (push (list column point) clm2pnts))) + (rst-destructuring-dolist + ((bullet _clm &rest pnts) + ;; Zip preferred bullets and sorted columns associating a bullet + ;; with a column and all the points this column is found. + (cl-mapcar #'(lambda (bullet clm2pnt) + (cons bullet clm2pnt)) + rst-preferred-bullets + (sort clm2pnts #'car-less-than-car))) + ;; Replace the bullets by the preferred ones. + (dolist (pnt pnts) + (goto-char pnt) + ;; FIXME: Assumes bullet to replace is a single char. + (delete-char 1) + (insert bullet)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Table of contents -;; ================= - -;; FIXME: Return value should be a `defstruct'. -(defun rst-section-tree () - "Return the hierarchical tree of section titles. -A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the -stripped text of the section title. MARKER is a marker for the -beginning of the title text. For the top node or a missing -section level node TITLE is nil and MARKER points to the title -text of the first child. Each CHILD is another tree entry. The -CHILD list may be empty." - (let ((hier (rst-get-hierarchy)) - (ch-sty2level (make-hash-table :test 'equal :size 10)) - lev-ttl-mrk-l) - - (let ((lev 0)) - (dolist (ado hier) - ;; Compare just the character and indent in the hash table. - (puthash (cons (car ado) (cadr ado)) lev ch-sty2level) - (incf lev))) - - ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment. - (save-excursion - (setq lev-ttl-mrk-l - (mapcar (lambda (ado) - (goto-char (point-min)) - (1value ;; This should really succeed. - (forward-line (1- (car ado)))) - (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level) - ;; Get title. - (save-excursion - (if (re-search-forward - (rst-re "\\S .*\\S ") (line-end-position) t) - (buffer-substring-no-properties - (match-beginning 0) (match-end 0)) - "")) - (point-marker))) - (rst-find-all-adornments)))) - (cdr (rst-section-tree-rec lev-ttl-mrk-l -1)))) - -;; FIXME: Return value should be a `defstruct'. -(defun rst-section-tree-rec (remaining lev) - "Process the first entry of REMAINING expected to be on level LEV. -REMAINING is the remaining list of adornments consisting -of (LEVEL TITLE MARKER) entries. - -Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry -of REMAINING where TITLE is nil if the expected level is not -matched. UNPROCESSED is the list of still unprocessed entries. -Each CHILD is a child of this entry in the same format but -without UNPROCESSED." - (let ((cur (car remaining)) - (unprocessed remaining) - ttl-mrk children) - ;; If the current adornment matches expected level. - (when (and cur (= (car cur) lev)) - ;; Consume the current entry and create the current node with it. - (setq unprocessed (cdr remaining)) - (setq ttl-mrk (cdr cur))) - - ;; Build the child nodes as long as they have deeper level. - (while (and unprocessed (> (caar unprocessed) lev)) - (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev)))) - (setq children (cons (cdr rem-children) children)) - (setq unprocessed (car rem-children)))) - (setq children (reverse children)) - - (cons unprocessed - (cons (or ttl-mrk - ;; Node on this level missing - use nil as text and the - ;; marker of the first child. - (cons nil (cdaar children))) - children)))) - -(defun rst-section-tree-point (tree &optional point) - "Return section containing POINT by returning the closest node in TREE. -TREE is a section tree as returned by `rst-section-tree' -consisting of (NODE CHILD...) entries. POINT defaults to the -current point. A NODE must have the structure (IGNORED MARKER...). - -Return (PATH NODE CHILD...). NODE is the node where POINT is in -if any. PATH is a list of nodes from the top of the tree down to -and including NODE. List of CHILD are the children of NODE if any." - (setq point (or point (point))) - (let ((cur (car tree)) - (children (cdr tree))) - ;; Point behind current node? - (if (and (cadr cur) (>= point (cadr cur))) - ;; Iterate all the children, looking for one that might contain the - ;; current section. - (let (found) - (while (and children (>= point (cadaar children))) - (setq found children - children (cdr children))) - (if found - ;; Found section containing point in children. - (let ((sub (rst-section-tree-point (car found) point))) - ;; Extend path with current node and return NODE CHILD... from - ;; sub. - (cons (cons cur (car sub)) (cdr sub))) - ;; Point in this section: Start a new path with current node and - ;; return current NODE CHILD... - (cons (list cur) tree))) - ;; Current node behind point: start a new path with current node and - ;; no NODE CHILD... - (list (list cur))))) + +(defun rst-all-stn () + ;; testcover: ok. + "Return the hierarchical tree of sections as a top level `rst-Stn'. +Return value satisfies `rst-Stn-is-top' or is nil for no +sections." + (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) + +(defun rst-remaining-stn (unprocessed expected) + ;; testcover: ok. + "Process the first entry of UNPROCESSED expected to be on level EXPECTED. +UNPROCESSED is the remaining list of (`rst-Ttl' . LEVEL) entries. +Return (REMAINING . STN) for the first entry of UNPROCESSED. +REMAINING is the list of still unprocessed entries. STN is a +`rst-Stn' or nil if UNPROCESSED is empty." + (if (not unprocessed) + (1value + (cons nil nil)) + (cl-destructuring-bind + ((ttl &rest level) &rest next + &aux fnd children) + unprocessed + (when (= level expected) + ;; Consume the current entry and create the current node with it. + (setq fnd ttl) + (setq unprocessed next)) + ;; Build the child nodes as long as they have deeper level. + (while (and unprocessed (> (cdar unprocessed) expected)) + (cl-destructuring-bind (remaining &rest stn) + (rst-remaining-stn unprocessed (1+ expected)) + (when stn + (push stn children)) + (setq unprocessed remaining))) + (cons unprocessed + (when (or fnd children) + (rst-Stn-new fnd expected (nreverse children))))))) + +(defun rst-stn-containing-point (stn &optional point) + ;; testcover: ok. + "Return `rst-Stn' in STN before POINT or nil if in no section. +POINT defaults to the current point. STN may be nil for no +section headers at all." + (when stn + (setq point (or point (point))) + (when (>= point (rst-Stn-get-title-beginning stn)) + ;; Point may be in this section or a child. + (let ((in-child (cl-find-if + #'(lambda (child) + (>= point (rst-Stn-get-title-beginning child))) + (rst-Stn-children stn) + :from-end t))) + (if in-child + (rst-stn-containing-point in-child point) + stn))))) (defgroup rst-toc nil "Settings for reStructuredText table of contents." @@ -2323,7 +2691,7 @@ indentation style: - `plain': no numbering (fixed indentation) - `fixed': numbering, but fixed indentation - `aligned': numbering, titles aligned under each other -- `listed': numbering, with dashes like list items (EXPERIMENTAL)" +- `listed': titles as list items" :type '(choice (const plain) (const fixed) (const aligned) @@ -2337,396 +2705,410 @@ indentation style: :group 'rst-toc) (rst-testcover-defcustom) -;; This is used to avoid having to change the user's mode. -(defvar rst-toc-insert-click-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'rst-toc-mode-mouse-goto) - map) - "(Internal) What happens when you click on propertized text in the TOC.") - (defcustom rst-toc-insert-max-level nil "If non-nil, maximum depth of the inserted TOC." :type '(choice (const nil) integer) :group 'rst-toc) (rst-testcover-defcustom) -(defun rst-toc-insert (&optional pfxarg) - "Insert a simple text rendering of the table of contents. +(defun rst-toc-insert (&optional max-level) + ;; testcover: ok. + "Insert the table of contents of the current section at the current column. By default the top level is ignored if there is only one, because -we assume that the document will have a single title. - -If a numeric prefix argument PFXARG is given, insert the TOC up -to the specified level. - -The TOC is inserted indented at the current column." +we assume that the document will have a single title. A numeric +prefix argument MAX-LEVEL overrides `rst-toc-insert-max-level'. +Text in the line beyond column is deleted." (interactive "P") (rst-reset-section-caches) - (let* (;; Check maximum level override. - (rst-toc-insert-max-level - (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) - (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) - - ;; Get the section tree for the current cursor point. - (sectree-pair - (rst-section-tree-point - (rst-section-tree))) - - ;; Figure out initial indent. - (initial-indent (make-string (current-column) ? )) - (init-point (point))) - - (when (cddr sectree-pair) - (rst-toc-insert-node (cdr sectree-pair) 0 initial-indent "") - - ;; Fixup for the first line. - (delete-region init-point (+ init-point (length initial-indent))) - - ;; Delete the last newline added. - (delete-char -1)))) - -(defun rst-toc-insert-node (node level indent pfx) - "Insert tree node NODE in table-of-contents. -Recursive function that does printing of the inserted TOC. -LEVEL is the depth level of the sections in the tree. -INDENT is the indentation string. PFX is the prefix numbering, -that includes the alignment necessary for all the children of -level to align." - - ;; Note: we do child numbering from the parent, so we start number the - ;; children one level before we print them. - (let ((do-print (> level 0)) - (count 1)) - (when do-print - (insert indent) - (let ((b (point))) - (unless (equal rst-toc-insert-style 'plain) - (insert pfx rst-toc-insert-number-separator)) - (insert (or (caar node) "[missing node]")) - ;; Add properties to the text, even though in normal text mode it - ;; won't be doing anything for now. Not sure that I want to change - ;; mode stuff. At least the highlighting gives the idea that this - ;; is generated automatically. - (put-text-property b (point) 'mouse-face 'highlight) - (put-text-property b (point) 'rst-toc-target (cadar node)) - (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)) - (insert "\n") - - ;; Prepare indent for children. - (setq indent - (cond - ((eq rst-toc-insert-style 'plain) - (concat indent (make-string rst-toc-indent ? ))) - - ((eq rst-toc-insert-style 'fixed) - (concat indent (make-string rst-toc-indent ? ))) - - ((eq rst-toc-insert-style 'aligned) - (concat indent (make-string (+ (length pfx) 2) ? ))) - - ((eq rst-toc-insert-style 'listed) - (concat (substring indent 0 -3) - (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) - - (if (or (eq rst-toc-insert-max-level nil) - (< level rst-toc-insert-max-level)) - (let ((do-child-numbering (>= level 0)) - fmt) - (if do-child-numbering - (progn - ;; Add a separating dot if there is already a prefix. - (when (> (length pfx) 0) - (string-match (rst-re "[ \t\n]*\\'") pfx) - (setq pfx (concat (replace-match "" t t pfx) "."))) - - ;; Calculate the amount of space that the prefix will require - ;; for the numbers. - (if (cdr node) - (setq fmt (format "%%-%dd" - (1+ (floor (log (length (cdr node)) - 10)))))))) - - (dolist (child (cdr node)) - (rst-toc-insert-node child - (1+ level) - indent - (if do-child-numbering - (concat pfx (format fmt count)) pfx)) - (incf count)))))) + (let ((pt-stn (rst-stn-containing-point (rst-all-stn)))) + (when pt-stn + (let ((max + (if (and (integerp max-level) + (> (prefix-numeric-value max-level) 0)) + (prefix-numeric-value max-level) + rst-toc-insert-max-level)) + (ind (current-column)) + (buf (current-buffer)) + (tabs indent-tabs-mode) ; Copy buffer local value. + txt) + (setq txt + ;; Render to temporary buffer so markers are created correctly. + (with-temp-buffer + (rst-toc-insert-tree pt-stn buf rst-toc-insert-style max + rst-toc-link-keymap nil) + (goto-char (point-min)) + (when (rst-forward-line-strict 1) + ;; There are lines to indent. + (let ((indent-tabs-mode tabs)) + (indent-rigidly (point) (point-max) ind))) + (buffer-string))) + (unless (zerop (length txt)) + ;; Delete possible trailing text. + (delete-region (point) (line-beginning-position 2)) + (insert txt) + (backward-char 1)))))) + +(defun rst-toc-insert-link (pfx stn buf keymap) + ;; testcover: ok. + "Insert text of STN in BUF as a linked section reference at point. +If KEYMAP use this as keymap property. PFX is inserted before text." + (let ((beg (point))) + (insert pfx) + (insert (rst-Stn-get-text stn)) + (put-text-property beg (point) 'mouse-face 'highlight) + (insert "\n") + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf)) + (when keymap + (put-text-property beg (point) 'keymap keymap)))) + +(defun rst-toc-get-link (link-buf link-pnt) + ;; testcover: ok. + "Return the link from text property at LINK-PNT in LINK-BUF." + (let ((mrkr (get-text-property link-pnt 'rst-toc-target link-buf))) + (unless mrkr + (error "No section on this line")) + (unless (buffer-live-p (marker-buffer mrkr)) + (error "Buffer for this section was killed")) + mrkr)) +(defconst rst-toc-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'rst-toc-mouse-follow-link) + map) + "Keymap used for links in TOC.") + +(defun rst-toc-insert-tree (stn buf style depth keymap tgt-stn) + ;; testcover: ok. + "Insert table of contents of tree below top node STN in buffer BUF. +STYLE is the style to use and must be one of the symbols allowed +for `rst-toc-insert-style'. DEPTH is the maximum relative depth +from STN to insert or nil for no maximum depth. See +`rst-toc-insert-link' for KEYMAP. Return beginning of title line +if TGT-STN is rendered or nil if not rendered or TGT-STN is nil. +Just return nil if STN is nil." + (when stn + (rst-toc-insert-children (rst-Stn-children stn) buf style depth 0 "" keymap + tgt-stn))) + +(defun rst-toc-insert-children (children buf style depth indent numbering + keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert CHILDREN in BUF to table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. See +`rst-toc-insert-stn' for INDENT and NUMBERING. See +`rst-toc-insert-link' for KEYMAP." + (let ((count 1) + ;; Child numbering is done from the parent. + (num-fmt (format "%%%dd" + (1+ (floor (log (1+ (length children)) 10))))) + fnd) + (when (not (equal numbering "")) + ;; Add separating dot to existing numbering. + (setq numbering (concat numbering "."))) + (dolist (child children fnd) + (setq fnd + (or (rst-toc-insert-stn child buf style depth indent + (concat numbering (format num-fmt count)) + keymap tgt-stn) fnd)) + (cl-incf count)))) + +;; FIXME refactoring: Use `rst-Stn-buffer' instead of `buf'. +(defun rst-toc-insert-stn (stn buf style depth indent numbering keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert STN in BUF into table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. INDENT +is the indentation depth to use for STN. NUMBERING is the prefix +numbering for STN. See `rst-toc-insert-link' for KEYMAP." + (when (or (not depth) (> depth 0)) + (cl-destructuring-bind + (pfx add + &aux (fnd (when (and tgt-stn + (equal (rst-Stn-get-title-beginning stn) + (rst-Stn-get-title-beginning tgt-stn))) + (point)))) + (cond + ((eq style 'plain) + (list "" rst-toc-indent)) + ((eq style 'fixed) + (list (concat numbering rst-toc-insert-number-separator) + rst-toc-indent)) + ((eq style 'aligned) + (list (concat numbering rst-toc-insert-number-separator) + (+ (length numbering) + (length rst-toc-insert-number-separator)))) + ((eq style 'listed) + (list (format "%c " (car rst-preferred-bullets)) 2))) + ;; Indent using spaces so buffer characteristics like `indent-tabs-mode' + ;; do not matter. + (rst-toc-insert-link (concat (make-string indent ? ) pfx) stn buf keymap) + (or (rst-toc-insert-children (rst-Stn-children stn) buf style + (when depth + (1- depth)) + (+ indent add) numbering keymap tgt-stn) + fnd)))) (defun rst-toc-update () + ;; testcover: ok. "Automatically find the contents section of a document and update. Updates the inserted TOC if present. You can use this in your file-write hook to always make it up-to-date automatically." (interactive) - (save-excursion - ;; Find and delete an existing comment after the first contents directive. - ;; Delete that region. - (goto-char (point-min)) - ;; We look for the following and the following only (in other words, if your - ;; syntax differs, this won't work.). - ;; - ;; .. contents:: [...anything here...] - ;; [:field: value]... - ;; .. - ;; XXXXXXXX - ;; XXXXXXXX - ;; [more lines] - (let ((beg (re-search-forward - (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" - "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t)) - last-real) - (when beg - ;; Look for the first line that starts at the first column. - (forward-line 1) - (while (and - (< (point) (point-max)) - (or (if (looking-at - (rst-re 'hws-sta "\\S ")) ; indented content. - (setq last-real (point))) - (looking-at (rst-re 'lin-end)))) ; empty line. - (forward-line 1)) - (if last-real - (progn - (goto-char last-real) - (end-of-line) - (delete-region beg (point))) - (goto-char beg)) - (insert "\n ") - (rst-toc-insert)))) + (save-match-data + (save-excursion + ;; Find and delete an existing comment after the first contents + ;; directive. Delete that region. + (goto-char (point-min)) + ;; FIXME: Should accept indentation of the whole block. + ;; We look for the following and the following only (in other words, if + ;; your syntax differs, this won't work.). + ;; + ;; .. contents:: [...anything here...] + ;; [:field: value]... + ;; .. + ;; XXXXXXXX + ;; XXXXXXXX + ;; [more lines] + ;; FIXME: Works only for the first of these tocs. There should be a + ;; fixed text after the comment such as "RST-MODE ELECTRIC TOC". + ;; May be parameters such as `max-level' should be appended. + (let ((beg (re-search-forward + (1value + (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" + "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag)) + nil t)) + fnd) + (when + (and beg + (rst-forward-line-looking-at + 1 'lin-end + #'(lambda (mtcd) + (unless mtcd + (rst-apply-indented-blocks + (point) (point-max) (current-indentation) + #'(lambda (count _in-first _in-sub in-super in-empty + _relind) + (cond + ((or (> count 1) in-super)) + ((not in-empty) + (setq fnd (line-end-position)) + nil))))) + t))) + (when fnd + (delete-region beg fnd)) + (goto-char beg) + (insert "\n ") + ;; FIXME: Ignores an `max-level' given to the original + ;; `rst-toc-insert'. `max-level' could be rendered to the first + ;; line. + (rst-toc-insert))))) ;; Note: always return nil, because this may be used as a hook. nil) -;; Note: we cannot bind the TOC update on file write because it messes with -;; undo. If we disable undo, since it adds and removes characters, the -;; positions in the undo list are not making sense anymore. Dunno what to do -;; with this, it would be nice to update when saving. +;; FIXME: Updating the toc on saving would be nice. However, this doesn't work +;; correctly: ;; -;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) -;; (defun rst-toc-update-fun () -;; ;; Disable undo for the write file hook. -;; (let ((buffer-undo-list t)) (rst-toc-update) )) - -(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. - -;;------------------------------------------------------------------------------ - -(defun rst-toc-node (node level) - "Recursive function that does insert NODE at LEVEL in the table-of-contents." - - (if (> level 0) - (let ((b (point))) - ;; Insert line text. - (insert (make-string (* rst-toc-indent (1- level)) ? )) - (insert (or (caar node) "[missing node]")) - - ;; Highlight lines. - (put-text-property b (point) 'mouse-face 'highlight) +;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) +;; (defun rst-toc-update-fun () +;; ;; Disable undo for the write file hook. +;; (let ((buffer-undo-list t)) (rst-toc-update) )) - ;; Add link on lines. - (put-text-property b (point) 'rst-toc-target (cadar node)) - - (insert "\n"))) - - (dolist (child (cdr node)) - (rst-toc-node child (1+ level)))) - -(defun rst-toc-count-lines (node target-node) - "Count the number of lines from NODE to the TARGET-NODE node. -This recursive function returns a cons of the number of -additional lines that have been counted for its node and -children, and t if the node has been found." +;; Maintain an alias for compatibility. +(defalias 'rst-toc-insert-update 'rst-toc-update) - (let ((count 1) - found) - (if (eq node target-node) - (setq found t) - (let ((child (cdr node))) - (while (and child (not found)) - (let ((cl (rst-toc-count-lines (car child) target-node))) - (setq count (+ count (car cl)) - found (cdr cl) - child (cdr child)))))) - (cons count found))) - -(defvar rst-toc-buffer-name "*Table of Contents*" +(defconst rst-toc-buffer-name "*Table of Contents*" "Name of the Table of Contents buffer.") -(defvar rst-toc-return-wincfg nil +(defvar-local rst-toc-mode-return-wincfg nil "Window configuration to which to return when leaving the TOC.") - (defun rst-toc () - "Display a table-of-contents. -Finds all the section titles and their adornments in the -file, and displays a hierarchically-organized list of the -titles, which is essentially a table-of-contents of the -document. - -The Emacs buffer can be navigated, and selecting a section -brings the cursor in that section." + ;; testcover: ok. + "Display a table of contents for current buffer. +Displays all section titles found in the current buffer in a +hierarchical list. The resulting buffer can be navigated, and +selecting a section title moves the cursor to that section." (interactive) (rst-reset-section-caches) - (let* ((curbuf (list (current-window-configuration) (point-marker))) - (sectree (rst-section-tree)) - - (our-node (cdr (rst-section-tree-point sectree))) - line - - ;; Create a temporary buffer. - (buf (get-buffer-create rst-toc-buffer-name))) - + (let* ((wincfg (list (current-window-configuration) (point-marker))) + (sectree (rst-all-stn)) + (target-stn (rst-stn-containing-point sectree)) + (target-buf (current-buffer)) + (buf (get-buffer-create rst-toc-buffer-name)) + target-pos) (with-current-buffer buf (let ((inhibit-read-only t)) (rst-toc-mode) (delete-region (point-min) (point-max)) - (insert (format "Table of Contents: %s\n" (or (caar sectree) ""))) - (put-text-property (point-min) (point) - 'face (list '(background-color . "gray"))) - (rst-toc-node sectree 0) - - ;; Count the lines to our found node. - (let ((linefound (rst-toc-count-lines sectree our-node))) - (setq line (if (cdr linefound) (car linefound) 0))))) + ;; FIXME: Could use a customizable style. + (setq target-pos (rst-toc-insert-tree + sectree target-buf 'plain nil nil target-stn)))) (display-buffer buf) (pop-to-buffer buf) + (setq rst-toc-mode-return-wincfg wincfg) + (goto-char (or target-pos (point-min))))) - ;; Save the buffer to return to. - (set (make-local-variable 'rst-toc-return-wincfg) curbuf) - - ;; Move the cursor near the right section in the TOC. - (goto-char (point-min)) - (forward-line (1- line)))) - +;; Maintain an alias for compatibility. +(defalias 'rst-goto-section 'rst-toc-follow-link) + +(defun rst-toc-follow-link (link-buf link-pnt kill) + ;; testcover: ok. + "Follow the link to the section at LINK-PNT in LINK-BUF. +LINK-PNT and LINK-BUF default to the point in the current buffer. +With prefix argument KILL a TOC buffer is destroyed. Throw an +error if there is no working link at the given position." + (interactive "i\nd\nP") + (unless link-buf + (setq link-buf (current-buffer))) + ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is + ;; suppressed and invisible in interactive use. + (let ((mrkr (rst-toc-get-link link-buf link-pnt))) + (condition-case nil + (rst-toc-mode-return kill) + ;; Catch errors when not in `toc-mode'. + (error nil)) + (pop-to-buffer (marker-buffer mrkr)) + (goto-char mrkr) + ;; FIXME: Should be a customizable number of lines from beginning or end of + ;; window just like the argument to `recenter`. It would be ideal if + ;; the adornment is always completely visible. + (recenter 5))) -(defun rst-toc-mode-find-section () - "Get the section from text property at point." - (let ((pos (get-text-property (point) 'rst-toc-target))) - (unless pos - (error "No section on this line")) - (unless (buffer-live-p (marker-buffer pos)) - (error "Buffer for this section was killed")) - pos)) +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-goto-section 'rst-toc-mode-follow-link-kill) ;; FIXME: Cursor before or behind the list must be handled properly; before the ;; list should jump to the top and behind the list to the last normal ;; paragraph. -(defun rst-goto-section (&optional kill) - "Go to the section the current line describes. -If KILL a TOC buffer is destroyed." +(defun rst-toc-mode-follow-link-kill () + ;; testcover: ok. + "Follow the link to the section at point and kill the TOC buffer." (interactive) - (let ((pos (rst-toc-mode-find-section))) - (when kill - ;; FIXME: This should rather go to `rst-toc-mode-goto-section'. - (set-window-configuration (car rst-toc-return-wincfg)) - (kill-buffer (get-buffer rst-toc-buffer-name))) - (pop-to-buffer (marker-buffer pos)) - (goto-char pos) - ;; FIXME: make the recentering conditional on scroll. - (recenter 5))) + (rst-toc-follow-link (current-buffer) (point) t)) -(defun rst-toc-mode-goto-section () - "Go to the section the current line describes and kill the TOC buffer." - (interactive) - (rst-goto-section t)) +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto 'rst-toc-mouse-follow-link) -(defun rst-toc-mode-mouse-goto (event) +(defun rst-toc-mouse-follow-link (event kill) + ;; testcover: uncovered. "In `rst-toc' mode, go to the occurrence whose line you click on. -EVENT is the input event." - (interactive "e") - (let ((pos - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (rst-toc-mode-find-section))))) - (pop-to-buffer (marker-buffer pos)) - (goto-char pos) - (recenter 5))) +EVENT is the input event. Kill TOC buffer if KILL." + (interactive "e\ni") + (rst-toc-follow-link (window-buffer (posn-window (event-end event))) + (posn-point (event-end event)) kill)) -(defun rst-toc-mode-mouse-goto-kill (event) - "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well. +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto-kill 'rst-toc-mode-mouse-follow-link-kill) + +(defun rst-toc-mode-mouse-follow-link-kill (event) + ;; testcover: uncovered. + "Same as `rst-toc-mouse-follow-link', but kill TOC buffer as well. EVENT is the input event." (interactive "e") - (call-interactively 'rst-toc-mode-mouse-goto event) - (kill-buffer (get-buffer rst-toc-buffer-name))) + (rst-toc-mouse-follow-link event t)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-quit-window 'rst-toc-mode-return) -(defun rst-toc-quit-window () - "Leave the current TOC buffer." +(defun rst-toc-mode-return (kill) + ;; testcover: ok. + "Leave the current TOC buffer and return to the previous environment. +With prefix argument KILL non-nil, kill the buffer instead of +burying it." + (interactive "P") + (unless rst-toc-mode-return-wincfg + (error "Not in a `toc-mode' buffer")) + (cl-destructuring-bind + (wincfg pos + &aux (toc-buf (current-buffer))) + rst-toc-mode-return-wincfg + (set-window-configuration wincfg) + (goto-char pos) + (if kill + (kill-buffer toc-buf) + (bury-buffer toc-buf)))) + +(defun rst-toc-mode-return-kill () + ;; testcover: uncovered. + "Like `rst-toc-mode-return' but kill TOC buffer." (interactive) - (let ((retbuf rst-toc-return-wincfg)) - (set-window-configuration (car retbuf)) - (goto-char (cadr retbuf)))) + (rst-toc-mode-return t)) (defvar rst-toc-mode-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) - (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) - (define-key map "\C-m" 'rst-toc-mode-goto-section) - (define-key map "f" 'rst-toc-mode-goto-section) - (define-key map "q" 'rst-toc-quit-window) - (define-key map "z" 'kill-this-buffer) + (define-key map [mouse-1] #'rst-toc-mode-mouse-follow-link-kill) + (define-key map [mouse-2] #'rst-toc-mouse-follow-link) + (define-key map "\C-m" #'rst-toc-mode-follow-link-kill) + (define-key map "f" #'rst-toc-mode-follow-link-kill) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + (define-key map "q" #'rst-toc-mode-return) + (define-key map "z" #'rst-toc-mode-return-kill) map) "Keymap for `rst-toc-mode'.") -(put 'rst-toc-mode 'mode-class 'special) - -;; Could inherit from the new `special-mode'. -(define-derived-mode rst-toc-mode nil "ReST-TOC" - "Major mode for output from \\[rst-toc], the table-of-contents for the document." - (setq buffer-read-only t)) - -;; Note: use occur-mode (replace.el) as a good example to complete missing -;; features. +(define-derived-mode rst-toc-mode special-mode "ReST-TOC" + "Major mode for output from \\[rst-toc], the table-of-contents for the document. +\\{rst-toc-mode-map}" + ;; FIXME: `revert-buffer-function` must be defined so `revert-buffer` works + ;; as expected for a special mode. In particular the referred buffer + ;; needs to be rescanned and the TOC must be updated accordingly. + ;; FIXME: Should contain the name of the buffer this is the toc of. + (setq header-line-format "Table of Contents")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section movement commands -;; ========================= - -(defun rst-forward-section (&optional offset) - "Skip to the next reStructuredText section title. -OFFSET specifies how many titles to skip. Use a negative OFFSET -to move backwards in the file (default is to use 1)." - (interactive) +;; Section movement + +;; FIXME testcover: Use `testcover'. Mark up a function with sufficient test +;; coverage by a comment tagged with `testcover' after the +;; `defun'. Then move this comment. + +(defun rst-forward-section (offset) + "Jump forward OFFSET section titles ending up at the start of the title line. +OFFSET defaults to 1 and may be negative to move backward. An +OFFSET of 0 does not move unless point is inside a title. Go to +end or beginning of buffer if no more section titles in the desired +direction." + (interactive "p") (rst-reset-section-caches) - (let* (;; Default value for offset. - (offset (or offset 1)) - - ;; Get all the adornments in the file, with their line numbers. - (allados (rst-find-all-adornments)) - - ;; Get the current line. - (curline (line-number-at-pos)) - - (cur allados) - (idx 0)) - - ;; Find the index of the "next" adornment w.r.t. to the current line. - (while (and cur (< (caar cur) curline)) - (setq cur (cdr cur)) - (incf idx)) - ;; 'cur' is the adornment on or following the current line. - - (if (and (> offset 0) cur (= (caar cur) curline)) - (incf idx)) - - ;; Find the final index. - (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) - (setq cur (nth idx allados)) - - ;; If the index is positive, goto the line, otherwise go to the buffer - ;; boundaries. - (if (and cur (>= idx 0)) - (progn - (goto-char (point-min)) - (forward-line (1- (car cur)))) - (if (> offset 0) (goto-char (point-max)) (goto-char (point-min)))))) - -(defun rst-backward-section () - "Like `rst-forward-section', except move back one title." - (interactive) - (rst-forward-section -1)) - -;; FIXME: What is `allow-extend' for? + (let* ((ttls (rst-all-ttls)) + (count (length ttls)) + (pnt (point)) + (contained nil) ; Title contains point (or is after point otherwise). + (found (or (cl-position-if + ;; Find a title containing or after point. + #'(lambda (ttl) + (let ((cmp (rst-Ttl-contains ttl pnt))) + (cond + ((= cmp 0) ; Title contains point. + (setq contained t) + t) + ((> cmp 0) ; Title after point. + t)))) + ttls) + ;; Point after all titles. + count)) + (target (+ found offset + ;; If point is in plain text found title is already one + ;; step forward. + (if (and (not contained) (>= offset 0)) -1 0)))) + (goto-char (cond + ((< target 0) + (point-min)) + ((>= target count) + (point-max)) + ((and (not contained) (= offset 0)) + ;; Point not in title and should not move - do not move. + pnt) + ((rst-Ttl-get-title-beginning (nth target ttls))))))) + +(defun rst-backward-section (offset) + "Like `rst-forward-section', except move backward by OFFSET." + (interactive "p") + (rst-forward-section (- offset))) + +;; FIXME: What is `allow-extend' for? See `mark-paragraph' for an explanation. (defun rst-mark-section (&optional count allow-extend) "Select COUNT sections around point. Mark following sections for positive COUNT or preceding sections @@ -2751,96 +3133,26 @@ for negative COUNT." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are -;; always 2 or 3 characters apart horizontally with rest. +;; Indentation (defun rst-find-leftmost-column (beg end) - "Return the leftmost column in region BEG to END." + "Return the leftmost column spanned by region BEG to END. +The line containing the start of the region is always considered +spanned. If the region ends at the beginning of a line this line +is not considered spanned, otherwise it is spanned." (let (mincol) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (unless (looking-at (rst-re 'lin-end)) - (setq mincol (if mincol - (min mincol (current-column)) - (current-column)))) - (forward-line 1))) - mincol)) - -;; FIXME: This definition is old and deprecated. We need to move to the newer -;; version below. -(defmacro rst-iterate-leftmost-paragraphs - (beg end first-only body-consequent body-alternative) - ;; FIXME: The following comment is pretty useless. - "Call FUN at the beginning of each line, with an argument that -specifies whether we are at the first line of a paragraph that -starts at the leftmost column of the given region BEG and END. -Set FIRST-ONLY to true if you want to callback on the first line -of each paragraph only." - `(save-excursion - (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (previous nil valid) - - (curcol (current-column) - (current-column)) - - (valid (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))) - (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))))) - ((>= (point) endm)) - - (if (if ,first-only - (and valid (not previous)) - valid) - ,body-consequent - ,body-alternative))))) - -;; FIXME: This needs to be refactored. Probably this is simply a function -;; applying BODY rather than a macro. -(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) - "Evaluate BODY for each line in region defined by BEG END. -LEFTMOST is set to true if the line is one of the leftmost of the -entire paragraph. PARABEGIN is set to true if the line is the -first of a paragraph." - (declare (indent 1) (debug (sexp body))) - (destructuring-bind - (beg end parabegin leftmost isleftmost isempty) spec - - `(save-excursion - (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (empty-line-previous nil ,isempty) - - (,isempty (looking-at (rst-re 'lin-end)) - (looking-at (rst-re 'lin-end))) - - (,parabegin (not ,isempty) - (and empty-line-previous - (not ,isempty))) - - (,isleftmost (and (not ,isempty) - (= (current-column) ,leftmost)) - (and (not ,isempty) - (= (current-column) ,leftmost)))) - ((>= (point) endm)) - - (progn ,@body)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Indentation + (save-match-data + (save-excursion + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (unless (looking-at (rst-re 'lin-end)) + (setq mincol (if mincol + (min mincol (current-indentation)) + (current-indentation)))) + (rst-forward-line-strict 1 end))) + mincol))) ;; FIXME: At the moment only block comments with leading empty comment line are ;; supported. Comment lines with leading comment markup should be also @@ -2904,7 +3216,7 @@ COLUMN is the column of the tab. INNER is non-nil if this is an inner tab. I.e. a tab which does come from the basic indentation and not from inner alignment points." (save-excursion - (forward-line 0) + (rst-forward-line-strict 0) (save-match-data (unless (looking-at (rst-re 'lin-end)) (back-to-indentation) @@ -2926,7 +3238,8 @@ and not from inner alignment points." (if (zerop rst-indent-field) (push (list (match-end 2) (if (string= (match-string 2) "") 1 0) - t) tabs)))) + t) + tabs)))) ;; Directive. ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?")) (push (list (match-end 1) 0 t) tabs) @@ -2944,16 +3257,18 @@ and not from inner alignment points." (push (list (point) rst-indent-comment t) tabs))) ;; Start of literal block. (when (looking-at (rst-re 'lit-sta-2)) - (let ((tab0 (first tabs))) - (push (list (first tab0) - (+ (second tab0) + (cl-destructuring-bind (point offset _inner) (car tabs) + (push (list point + (+ offset (if (match-string 1) rst-indent-literal-minimized rst-indent-literal-normal)) - t) tabs))) - (mapcar (lambda (tab) - (goto-char (first tab)) - (cons (+ (current-column) (second tab)) (third tab))) + t) + tabs))) + (mapcar (cl-function + (lambda ((point offset inner)) + (goto-char point) + (cons (+ (current-column) offset) inner))) tabs)))))) (defun rst-compute-tabs (pt) @@ -2963,38 +3278,35 @@ Return a list of tabs sorted by likeliness to continue writing like `rst-line-tabs'. Nearer lines have generally a higher likeliness than farther lines. Return nil if no tab is found in the text above." + ;; FIXME: See test `indent-for-tab-command-BUGS`. (save-excursion (goto-char pt) (let (leftmost ; Leftmost column found so far. innermost ; Leftmost column for inner tab. tablist) - (while (and (zerop (forward-line -1)) + (while (and (rst-forward-line-strict -1) (or (not leftmost) (> leftmost 0))) - (let* ((tabs (rst-line-tabs)) - (leftcol (if tabs (apply 'min (mapcar 'car tabs))))) + (let ((tabs (rst-line-tabs))) (when tabs - ;; Consider only lines indented less or same if not INNERMOST. - (when (or (not leftmost) - (< leftcol leftmost) - (and (not innermost) (= leftcol leftmost))) - (dolist (tab tabs) - (let ((inner (cdr tab)) - (newcol (car tab))) - (when (and - (or - (and (not inner) - (or (not leftmost) - (< newcol leftmost))) - (and inner - (or (not innermost) - (< newcol innermost)))) - (not (memq newcol tablist))) - (push newcol tablist)))) - (setq innermost (if (rst-some (mapcar 'cdr tabs)) ; Has inner. - leftcol - innermost)) - (setq leftmost leftcol))))) + (let ((leftcol (apply #'min (mapcar #'car tabs)))) + ;; Consider only lines indented less or same if not INNERMOST. + (when (or (not leftmost) + (< leftcol leftmost) + (and (not innermost) (= leftcol leftmost))) + (rst-destructuring-dolist ((column &rest inner) tabs) + (when (or + (and (not inner) + (or (not leftmost) + (< column leftmost))) + (and inner + (or (not innermost) + (< column innermost)))) + (setq tablist (cl-adjoin column tablist)))) + (setq innermost (if (cl-some #'cdr tabs) ; Has inner. + leftcol + innermost)) + (setq leftmost leftcol)))))) (nreverse tablist)))) (defun rst-indent-line (&optional dflt) @@ -3012,7 +3324,7 @@ relative to the content." (cur (current-indentation)) (clm (current-column)) (tabs (rst-compute-tabs (point))) - (fnd (rst-position cur tabs)) + (fnd (cl-position cur tabs :test #'equal)) ind) (if (and (not tabs) (not dflt)) 'noindent @@ -3036,7 +3348,9 @@ Shift by one tab to the right (CNT > 0) or left (CNT < 0) or remove all indentation (CNT = 0). A tab is taken from the text above. If no suitable tab is found `rst-indent-width' is used." (interactive "r\np") - (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y)))) + (let ((tabs (sort (rst-compute-tabs beg) + #'(lambda (x y) + (<= x y)))) (leftmostcol (rst-find-leftmost-column beg end))) (when (or (> leftmostcol 0) (> cnt 0)) ;; Apply the indent. @@ -3045,17 +3359,15 @@ above. If no suitable tab is found `rst-indent-width' is used." (if (zerop cnt) (- leftmostcol) ;; Find the next tab after the leftmost column. - (let* ((cmp (if (> cnt 0) '> '<)) + (let* ((cmp (if (> cnt 0) #'> #'<)) (tabs (if (> cnt 0) tabs (reverse tabs))) (len (length tabs)) - (dir (rst-signum cnt)) ; Direction to take. + (dir (cl-signum cnt)) ; Direction to take. (abs (abs cnt)) ; Absolute number of steps to take. ;; Get the position of the first tab beyond leftmostcol. - (fnd (lexical-let ((cmp cmp) - (leftmostcol leftmostcol)) ; Create closure. - (rst-position-if (lambda (elt) - (funcall cmp elt leftmostcol)) - tabs))) + (fnd (cl-position-if #'(lambda (elt) + (funcall cmp elt leftmostcol)) + tabs)) ;; Virtual position of tab. (pos (+ (or fnd len) (1- abs))) (tab (if (< pos len) @@ -3078,20 +3390,21 @@ above. If no suitable tab is found `rst-indent-width' is used." (defun rst-adaptive-fill () "Return fill prefix found at point. Value for `adaptive-fill-function'." - (let ((fnd (if (looking-at adaptive-fill-regexp) - (match-string-no-properties 0)))) - (if (save-match-data - (not (string-match comment-start-skip fnd))) - ;; An non-comment prefix is fine. - fnd - ;; Matches a comment - return whitespace instead. - (make-string (- - (save-excursion - (goto-char (match-end 0)) - (current-column)) - (save-excursion - (goto-char (match-beginning 0)) - (current-column))) ? )))) + (save-match-data + (let ((fnd (if (looking-at adaptive-fill-regexp) + (match-string-no-properties 0)))) + (if (save-match-data + (not (string-match comment-start-skip fnd))) + ;; An non-comment prefix is fine. + fnd + ;; Matches a comment - return whitespace instead. + (make-string (- + (save-excursion + (goto-char (match-end 0)) + (current-column)) + (save-excursion + (goto-char (match-beginning 0)) + (current-column))) ? ))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Comments @@ -3127,10 +3440,9 @@ Region is from BEG to END. Uncomment if ARG." (if (consp arg) (rst-uncomment-region beg end arg) (goto-char beg) + (rst-forward-line-strict 0) (let ((ind (current-indentation)) - bol) - (forward-line 0) - (setq bol (point)) + (bol (point))) (indent-rigidly bol end rst-indent-comment) (goto-char bol) (open-line 1) @@ -3139,18 +3451,18 @@ Region is from BEG to END. Uncomment if ARG." (defun rst-uncomment-region (beg end &optional _arg) "Uncomment the current region. -Region is from BEG to END. ARG is ignored" +Region is from BEG to END. _ARG is ignored" (save-excursion - (let (bol eol) - (goto-char beg) - (forward-line 0) - (setq bol (point)) - (forward-line 1) - (setq eol (point)) - (indent-rigidly eol end (- rst-indent-comment)) - (delete-region bol eol)))) + (goto-char beg) + (rst-forward-line-strict 0) + (let ((bol (point))) + (rst-forward-line-strict 1 end) + (indent-rigidly (point) end (- rst-indent-comment)) + (goto-char bol) + (rst-delete-entire-line 0)))) -;;------------------------------------------------------------------------------ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Apply to indented block ;; FIXME: These next functions should become part of a larger effort to redo ;; the bullets in bulleted lists. The enumerate would just be one of @@ -3158,29 +3470,127 @@ Region is from BEG to END. ARG is ignored" ;; ;; FIXME: We need to do the enumeration removal as well. +(defun rst-apply-indented-blocks (beg end ind fun) + "Apply FUN to all lines from BEG to END in blocks indented to IND. +The first indented block starts with the first non-empty line +containing or after BEG and indented to IND. After the first +line the indented block may contain more lines with same +indentation (the paragraph) followed by empty lines and lines +more indented (the sub-blocks). A following line indented to IND +starts the next paragraph. A non-empty line with less +indentation than IND terminates the current paragraph. FUN is +applied to each line like this + + (FUN COUNT IN-FIRST IN-SUB IN-SUPER IN-EMPTY RELIND) + +COUNT is 0 before the first paragraph and increments for every +paragraph found on level IND. IN-FIRST is non-nil if this is the +first line of such a paragraph. IN-SUB is non-nil if this line +is part of a sub-block while IN-SUPER is non-nil of this line is +part of a less indented block (super-block). IN-EMPTY is non-nil +if this line is empty where an empty line is considered being +part of the previous block. RELIND is nil for an empty line, 0 +for a line indented to IND, and the positive or negative number +of columns more or less indented otherwise. When FUN is called +point is immediately behind indentation of that line. FUN may +change everything as long as a marker at END and at the beginning +of the following line is handled correctly by the change. A +non-nil return value from FUN breaks the loop and is returned. +Otherwise return nil." + (let ((endm (copy-marker end t)) + (count 0) ; Before first indented block. + (nxt (when (< beg end) + (copy-marker beg t))) + (broken t) + in-sub in-super stop) + (save-match-data + (save-excursion + (while (and (not stop) nxt) + (set-marker + (goto-char nxt) nil) + (setq nxt (save-excursion + ;; FIXME refactoring: Replace `(forward-line) + ;; (back-to-indentation)` by + ;; `(forward-to-indentation)` + (when (and (rst-forward-line-strict 1 endm) + (< (point) endm)) + (copy-marker (point) t)))) + (back-to-indentation) + (let ((relind (- (current-indentation) ind)) + (in-empty (looking-at (rst-re 'lin-end))) + in-first) + (cond + (in-empty + (setq relind nil)) + ((< relind 0) + (setq in-sub nil) + (setq in-super t)) + ((> relind 0) + (setq in-sub t) + (setq in-super nil)) + (t ; Non-empty line in indented block. + (when (or broken in-sub in-super) + (setq in-first t) + (cl-incf count)) + (setq in-sub nil) + (setq in-super nil))) + (save-excursion + (setq + stop + (funcall fun count in-first in-sub in-super in-empty relind))) + (setq broken in-empty))) + (set-marker endm nil) + stop)))) + (defun rst-enumerate-region (beg end all) "Add enumeration to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (let ((count 0) - (last-insert-len nil)) - (rst-iterate-leftmost-paragraphs - beg end (not all) - (let ((ins-string (format "%d. " (incf count)))) - (setq last-insert-len (length ins-string)) - (insert ins-string)) - (insert (make-string last-insert-len ?\ ))))) - + (let ((enum 0) + (indent "")) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (let ((tag (format "%d. " (cl-incf enum)))) + (setq indent (make-string (length tag) ? )) + (insert tag))) + (t + (insert indent))) + nil)))) + +;; FIXME: Does not deal with deeper indentation - although +;; `rst-apply-indented-blocks' could. (defun rst-bullet-list-region (beg end all) "Add bullets to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (rst-iterate-leftmost-paragraphs - beg end (not all) - (insert (car rst-preferred-bullets) " ") - (insert " "))) + (unless rst-preferred-bullets + (error "No preferred bullets defined")) + (let* ((bul (format "%c " (car rst-preferred-bullets))) + (indent (make-string (length bul) ? ))) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (insert bul)) + (t + (insert indent))) + nil)))) ;; FIXME: Does not deal with a varying number of digits appropriately. ;; FIXME: Does not deal with multiple levels independently. @@ -3189,43 +3599,36 @@ do all lines instead of just paragraphs." "Convert the bulleted and enumerated items in the region to enumerated lists. Renumber as necessary. Region is from BEG to END." (interactive "r") - (let* (;; Find items and convert the positions to markers. - (items (mapcar - (lambda (x) - (cons (copy-marker (car x)) - (cdr x))) - (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1)))) - (count 1)) - (save-excursion - (dolist (x items) - (goto-char (car x)) - (looking-at (rst-re 'itmany-beg-1)) - (replace-match (format "%d." count) nil nil nil 1) - (incf count))))) - -;;------------------------------------------------------------------------------ - -(defun rst-line-block-region (rbeg rend &optional pfxarg) - "Toggle line block prefixes for a region. -Region is from RBEG to REND. With PFXARG set the empty lines too." + (let ((count 1)) + (save-match-data + (save-excursion + (dolist (marker (mapcar + (cl-function + (lambda ((pnt &rest clm)) + (copy-marker pnt))) + (rst-find-begs beg end 'itmany-beg-1))) + (set-marker + (goto-char marker) nil) + (looking-at (rst-re 'itmany-beg-1)) + (replace-match (format "%d." count) nil nil nil 1) + (cl-incf count)))))) + +(defun rst-line-block-region (beg end &optional with-empty) + "Add line block prefixes for a region. +Region is from BEG to END. With WITH-EMPTY prefix empty lines too." (interactive "r\nP") - (let ((comment-start "| ") - (comment-end "") - (comment-start-skip "| ") - (comment-style 'indent) - (force (not (not pfxarg)))) - (rst-iterate-leftmost-paragraphs-2 - (rbeg rend parbegin leftmost isleft isempty) - (when (or force (not isempty)) - (move-to-column leftmost force) - (delete-region (point) (+ (point) (- (current-indentation) leftmost))) - (insert "| "))))) - + (let ((ind (rst-find-leftmost-column beg end))) + (rst-apply-indented-blocks + beg end ind + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (when (and (not in-super) (or with-empty (not in-empty))) + (move-to-column ind t) + (insert "| ")) + nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font lock -;; ========= (require 'font-lock) @@ -3525,7 +3928,7 @@ of your own." (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) 1 rst-definition-face) ;; `Hyperlink References`_ - ;; FIXME: `Embedded URIs`_ not considered. + ;; FIXME: `Embedded URIs and Aliases`_ not considered. ;; FIXME: Directly adjacent marked up words are not fontified correctly ;; unless they are not separated by two spaces: foo_ bar_. (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") @@ -3670,14 +4073,16 @@ Return nil if not or a cons with new values for BEG / END" (if (or nbeg nend) (cons (or nbeg beg) (or nend end))))) +;; FIXME refactoring: Use `rst-forward-line-strict' instead. (defun rst-forward-line (&optional n) "Like `forward-line' but always end up in column 0 and return accordingly. Move N lines forward just as `forward-line'." - (let ((moved (forward-line n))) + (let ((left (forward-line n))) (if (bolp) - moved + left + ;; FIXME: This may move back for positive n - is this desired? (forward-line 0) - (- moved (rst-signum n))))) + (- left (cl-signum n))))) ;; FIXME: If a single line is made a section header by `rst-adjust' the header ;; is not always fontified immediately. @@ -3698,77 +4103,74 @@ Return extended point or nil if not moved." ;; The second group consists of the adornment cases. (if (not (get-text-property pt 'font-lock-multiline)) ;; Move only if we don't start inside a multiline construct already. - (save-excursion - (let (;; Non-empty non-indented line, explicit markup tag or literal - ;; block tag. - (stop-re (rst-re '(:alt "[^ \t\n]" - (:seq hws-tag exm-tag) - (:seq ".*" dcl-tag lin-end))))) - ;; The comments below are for dir == -1 / dir == 1. - (goto-char pt) - (forward-line 0) - (setq pt (point)) - (while (and (not (looking-at stop-re)) - (zerop (rst-forward-line dir)))) ; try previous / next - ; line if it exists. - (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / - ; overline. - (if (zerop (rst-forward-line dir)) - (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e. - ; underline / overline - ; found. - (if (zerop (rst-forward-line dir)) - (if (not - (looking-at (rst-re 'ado-beg-2-1))) ; no - ; overline / - ; underline. - (rst-forward-line (- dir)))) ; step back to title - ; / adornment. - (if (< dir 0) ; keep downward adornment. - (rst-forward-line (- dir))))) ; step back to adornment. - (if (looking-at (rst-re 'ttl-beg)) ; may be a title. + (save-match-data + (save-excursion + (let ( ; Non-empty non-indented line, explicit markup tag or literal + ; block tag. + (stop-re (rst-re '(:alt "[^ \t\n]" + (:seq hws-tag exm-tag) + (:seq ".*" dcl-tag lin-end))))) + ;; The comments below are for dir == -1 / dir == 1. + (goto-char pt) + (rst-forward-line-strict 0) + (setq pt (point)) + (while (and (not (looking-at stop-re)) + (zerop (rst-forward-line dir)))) ; try previous / next + ; line if it exists. + (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / + ; overline. (if (zerop (rst-forward-line dir)) - (if (not - (looking-at (rst-re 'ado-beg-2-1))) ; no overline / - ; underline. - (rst-forward-line (- dir)))))) ; step back to line. - (if (not (= (point) pt)) - (point)))))) + (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e. + ; underline / overline + ; found. + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no + ; overline + ; / + ; underline. + (rst-forward-line (- dir)))) ; step back to + ; title / + ; adornment. + (if (< dir 0) ; keep downward adornment. + (rst-forward-line (- dir))))) ; step back to adornment. + (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title. + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no overline / + ; underline. + (rst-forward-line (- dir)))))) ; step back to line. + (if (not (= (point) pt)) + (point))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indented blocks (defun rst-forward-indented-block (&optional column limit) + ;; testcover: ok. "Move forward across one indented block. -Find the next non-empty line which is not indented at least to COLUMN (defaults -to the column of the point). Moves point to first character of this line or the -first empty line immediately before it and returns that position. If there is -no such line before LIMIT (defaults to the end of the buffer) returns nil and -point is not moved." - (interactive) - (let ((clm (or column (current-column))) - (start (point)) - fnd beg cand) - (if (not limit) - (setq limit (point-max))) - (save-match-data - (while (and (not fnd) (< (point) limit)) - (forward-line 1) - (when (< (point) limit) - (setq beg (point)) - (if (looking-at (rst-re 'lin-end)) - (setq cand (or cand beg)) ; An empty line is a candidate. - (move-to-column clm) - ;; FIXME: No indentation [(zerop clm)] must be handled in some - ;; useful way - though it is not clear what this should mean - ;; at all. - (if (string-match - (rst-re 'linemp-tag) - (buffer-substring-no-properties beg (point))) - (setq cand nil) ; An indented line resets a candidate. - (setq fnd (or cand beg))))))) - (goto-char (or fnd start)) - fnd)) +Find the next (i.e. excluding the current line) non-empty line +which is not indented at least to COLUMN (defaults to the column +of the point). Move point to first character of this line or the +first of the empty lines immediately before it and return that +position. If there is no such line before LIMIT (defaults to the +end of the buffer) return nil and do not move point." + (let (fnd candidate) + (setq fnd (rst-apply-indented-blocks + (line-beginning-position 2) ; Skip the current line + (or limit (point-max)) (or column (current-column)) + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (cond + (in-empty + (setq candidate (or candidate (line-beginning-position))) + nil) + (in-super + (or candidate (line-beginning-position))) + (t ; Non-empty, same or more indented line. + (setq candidate nil) + nil))))) + (when fnd + (goto-char fnd)))) (defvar rst-font-lock-find-unindented-line-begin nil "Beginning of the match if `rst-font-lock-find-unindented-line-end'.") @@ -3786,48 +4188,49 @@ IND-PNT is non-nil but not a number take the indentation from the next non-empty line if this is indented more than the current one." (setq rst-font-lock-find-unindented-line-begin ind-pnt) (setq rst-font-lock-find-unindented-line-end - (save-excursion - (when (not (numberp ind-pnt)) - ;; Find indentation point in next line if any. - (setq ind-pnt - ;; FIXME: Should be refactored to two different functions - ;; giving their result to this function, may be - ;; integrated in caller. - (save-match-data - (let ((cur-ind (current-indentation))) - (if (eq ind-pnt 'next) - (when (and (zerop (forward-line 1)) - (< (point) (point-max))) - ;; Not at EOF. - (setq rst-font-lock-find-unindented-line-begin - (point)) - (when (and (not (looking-at (rst-re 'lin-end))) - (> (current-indentation) cur-ind)) + (save-match-data + (save-excursion + (when (not (numberp ind-pnt)) + ;; Find indentation point in next line if any. + (setq ind-pnt + ;; FIXME: Should be refactored to two different functions + ;; giving their result to this function, may be + ;; integrated in caller. + (save-match-data + (let ((cur-ind (current-indentation))) + (if (eq ind-pnt 'next) + (when (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max))) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (and (not (looking-at (rst-re 'lin-end))) + (> (current-indentation) cur-ind)) ;; Use end of indentation if non-empty line. (looking-at (rst-re 'hws-tag)) (match-end 0))) - ;; Skip until non-empty line or EOF. - (while (and (zerop (forward-line 1)) - (< (point) (point-max)) - (looking-at (rst-re 'lin-end)))) - (when (< (point) (point-max)) - ;; Not at EOF. - (setq rst-font-lock-find-unindented-line-begin - (point)) - (when (> (current-indentation) cur-ind) - ;; Indentation bigger than line of departure. - (looking-at (rst-re 'hws-tag)) - (match-end 0)))))))) - (when ind-pnt - (goto-char ind-pnt) - (or (rst-forward-indented-block nil (point-max)) - (point-max)))))) + ;; Skip until non-empty line or EOF. + (while (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max)) + (looking-at (rst-re 'lin-end)))) + (when (< (point) (point-max)) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (> (current-indentation) cur-ind) + ;; Indentation bigger than line of departure. + (looking-at (rst-re 'hws-tag)) + (match-end 0)))))))) + (when ind-pnt + (goto-char ind-pnt) + (or (rst-forward-indented-block nil (point-max)) + (point-max))))))) (defun rst-font-lock-find-unindented-line-match (_limit) "Set the match found earlier if match were found. Match has been found by `rst-font-lock-find-unindented-line-limit' the first time called or no match is found. Return non-nil if -match was found. LIMIT is not used but mandated by the caller." +match was found. _LIMIT is not used but mandated by the caller." (when rst-font-lock-find-unindented-line-end (set-match-data (list rst-font-lock-find-unindented-line-begin @@ -3846,22 +4249,14 @@ match was found. LIMIT is not used but mandated by the caller." "Storage for `rst-font-lock-handle-adornment-matcher'. Either section level of the current adornment or t for a transition.") -(defun rst-adornment-level (key) - "Return section level for adornment KEY. -KEY is the first element of the return list of `rst-classify-adornment'. -If KEY is not a cons return it. If KEY is found in the hierarchy return -its level. Otherwise return a level one beyond the existing hierarchy." - (if (not (consp key)) - key - (let* ((hier (rst-get-hierarchy)) - (char (car key)) - (style (cdr key))) - (1+ (or (lexical-let ((char char) - (style style) - (hier hier)) ; Create closure. - (rst-position-if (lambda (elt) - (and (equal (car elt) char) - (equal (cadr elt) style))) hier)) +(defun rst-adornment-level (ado) + "Return section level for ADO or t for a transition. +If ADO is found in the hierarchy return its level. Otherwise +return a level one beyond the existing hierarchy." + (if (rst-Ado-is-transition ado) + t + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (1+ (or (rst-Ado-position ado hier) (length hier)))))) (defvar rst-font-lock-adornment-match nil @@ -3878,15 +4273,15 @@ matched. ADO-END is the point where ADO ends. Return the point where the whole adorned construct ends. Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'." - (let ((ado-data (rst-classify-adornment ado ado-end))) - (if (not ado-data) + (let ((ttl (rst-classify-adornment ado ado-end))) + (if (not ttl) (setq rst-font-lock-adornment-level nil rst-font-lock-adornment-match nil) (setq rst-font-lock-adornment-level - (rst-adornment-level (car ado-data))) - (setq rst-font-lock-adornment-match (cdr ado-data)) - (goto-char (nth 1 ado-data)) ; Beginning of construct. - (nth 2 ado-data)))) ; End of construct. + (rst-adornment-level (rst-Ttl-ado ttl))) + (setq rst-font-lock-adornment-match (rst-Ttl-match ttl)) + (goto-char (rst-Ttl-get-beginning ttl)) + (rst-Ttl-get-end ttl)))) (defun rst-font-lock-handle-adornment-matcher (_limit) "Set the match found earlier if match were found. @@ -3895,7 +4290,7 @@ Match has been found by called or no match is found. Return non-nil if match was found. Called as a MATCHER in the sense of `font-lock-keywords'. -LIMIT is not used but mandated by the caller." +_LIMIT is not used but mandated by the caller." (let ((match rst-font-lock-adornment-match)) ;; May run only once - enforce this. (setq rst-font-lock-adornment-match nil) @@ -3933,6 +4328,13 @@ document with \\[rst-compile]." ".pdf" nil) (s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5") ".html" nil)) + ;; FIXME: Add at least those converters officially supported like `rst2odt' + ;; and `rst2man'. + ;; FIXME: To make this really useful there should be a generic command the + ;; user gives one of the symbols and this way select the conversion to + ;; run. This should replace the toolset stuff somehow. + ;; FIXME: Allow a template for the conversion command so `rst2pdf ... -o ...' + ;; can be supported. "Table describing the command to use for each tool-set. An association list of the tool-set to a list of the (command to use, extension of produced filename, options to the tool (nil or a @@ -3990,32 +4392,31 @@ select the alternative tool-set." (interactive "P") ;; Note: maybe we want to check if there is a Makefile too and not do anything ;; if that is the case. I dunno. - (let* ((toolset (cdr (assq (if use-alt - rst-compile-secondary-toolset - rst-compile-primary-toolset) - rst-compile-toolsets))) - (command (car toolset)) - (extension (cadr toolset)) - (options (caddr toolset)) - (conffile (rst-compile-find-conf)) - (bufname (file-name-nondirectory buffer-file-name)) - (outname (file-name-sans-extension bufname))) - + (cl-destructuring-bind + (command extension options + &aux (conffile (rst-compile-find-conf)) + (bufname (file-name-nondirectory buffer-file-name))) + (cdr (assq (if use-alt + rst-compile-secondary-toolset + rst-compile-primary-toolset) + rst-compile-toolsets)) ;; Set compile-command before invocation of compile. - (set (make-local-variable 'compile-command) - (mapconcat 'identity - (list command - (or options "") - (if conffile - (concat "--config=" (shell-quote-argument conffile)) - "") - (shell-quote-argument bufname) - (shell-quote-argument (concat outname extension))) - " ")) - + (setq-local + compile-command + (mapconcat + #'identity + (list command + (or options "") + (if conffile + (concat "--config=" (shell-quote-argument conffile)) + "") + (shell-quote-argument bufname) + (shell-quote-argument (concat (file-name-sans-extension bufname) + extension))) + " ")) ;; Invoke the compile command. (if (or compilation-read-command use-alt) - (call-interactively 'compile) + (call-interactively #'compile) (compile compile-command)))) (defun rst-compile-alt-toolset () @@ -4036,7 +4437,7 @@ buffer, if the region is not selected." (cadr (assq 'pseudoxml rst-compile-toolsets)) standard-output))) -;; FIXME: Should be defcustom. +;; FIXME: Should be integrated in `rst-compile-toolsets'. (defvar rst-pdf-program "xpdf" "Program used to preview PDF files.") @@ -4053,7 +4454,8 @@ buffer, if the region is not selected." ;; output. )) -;; FIXME: Should be defcustom or use something like `browse-url'. +;; FIXME: Should be integrated in `rst-compile-toolsets' defaulting to +;; something like `browse-url'. (defvar rst-slides-program "firefox" "Program used to preview S5 slides.") @@ -4070,56 +4472,45 @@ buffer, if the region is not selected." ;; output. )) +;; FIXME: Add `rst-compile-html-preview'. + +;; FIXME: Add support for `restview` (http://mg.pov.lt/restview/). May be a +;; more general facility for calling commands on a reST file would make +;; sense. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Imenu support. - -;; FIXME: Integrate this properly. Consider a key binding. - -;; Based on code from Masatake YAMATO <yamato@redhat.com>. - -(defun rst-imenu-find-adornments-for-position (adornments pos) - "Find adornments cell in ADORNMENTS for position POS." - (let ((a nil)) - (while adornments - (if (and (car adornments) - (eq (car (car adornments)) pos)) - (setq a adornments - adornments nil) - (setq adornments (cdr adornments)))) - a)) - -(defun rst-imenu-convert-cell (elt adornments) - "Convert a cell ELT in a tree returned from `rst-section-tree' to Imenu index. -ADORNMENTS is used as hint information for conversion." - (let* ((kar (car elt)) - (kdr (cdr elt)) - (title (car kar))) - (if kar - (let* ((p (marker-position (cadr kar))) - (adornments - (rst-imenu-find-adornments-for-position adornments p)) - (a (car adornments)) - (adornments (cdr adornments)) - ;; FIXME: Overline adornment characters need to be in front so - ;; they become visible even for long title lines. May be - ;; an additional level number is also useful. - (title (format "%s%s%s" - (make-string (1+ (nth 3 a)) (nth 1 a)) - title - (if (eq (nth 2 a) 'simple) - "" - (char-to-string (nth 1 a)))))) - (cons title - (if (null kdr) - p - (cons - ;; A bit ugly but this make which-func happy. - (cons title p) - (mapcar (lambda (elt0) - (rst-imenu-convert-cell elt0 adornments)) - kdr))))) - nil))) +;; Imenu support + +;; FIXME: Consider a key binding. A key binding needs to definitely switch on +;; `which-func-mode' - i.e. `which-func-modes' must be set properly. + +;; Based on ideas from Masatake YAMATO <yamato@redhat.com>. + +(defun rst-imenu-convert-cell (stn) + "Convert a STN to an Imenu index node and return it." + (let ((ttl (rst-Stn-ttl stn)) + (children (rst-Stn-children stn)) + (pos (rst-Stn-get-title-beginning stn)) + (txt (rst-Stn-get-text stn "")) + (pfx " ") + (sfx "") + name) + (when ttl + (let ((hdr (rst-Ttl-hdr ttl))) + (setq pfx (char-to-string (rst-Hdr-get-char hdr))) + (when (rst-Hdr-is-over-and-under hdr) + (setq sfx pfx)))) + ;; FIXME: Overline adornment characters need to be in front so they + ;; become visible even for long title lines. May be an additional + ;; level number is also useful. + (setq name (format "%s%s%s" pfx txt sfx)) + (cons name ; The name of the entry. + (if children + (cons ; The entry has a submenu. + (cons name pos) ; The entry itself. + (mapcar #'rst-imenu-convert-cell children)) ; The children. + pos)))) ; The position of a plain entry. ;; FIXME: Document title and subtitle need to be handled properly. They should ;; get an own "Document" top level entry. @@ -4127,25 +4518,13 @@ ADORNMENTS is used as hint information for conversion." "Create index for Imenu. Return as described for `imenu--index-alist'." (rst-reset-section-caches) - (let ((tree (rst-section-tree)) - ;; Translate line notation to point notation. - (adornments (save-excursion - (mapcar (lambda (ln-ado) - (cons (progn - (goto-char (point-min)) - (forward-line (1- (car ln-ado))) - ;; FIXME: Need to consider - ;; `imenu-use-markers' here? - (point)) - (cdr ln-ado))) - (rst-find-all-adornments))))) - (delete nil (mapcar (lambda (elt) - (rst-imenu-convert-cell elt adornments)) - tree)))) + (let ((root (rst-all-stn))) + (when root + (mapcar #'rst-imenu-convert-cell (rst-Stn-children root))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Generic text functions that are more convenient than the defaults. +;; Convenience functions ;; FIXME: Unbound command - should be bound or removed. (defun rst-replace-lines (fromchar tochar) @@ -4160,7 +4539,7 @@ cand replace with char: ") (setq found (1+ found)) (goto-char (match-beginning 1)) (let ((width (current-column))) - (rst-delete-entire-line) + (rst-delete-entire-line 0) (insert-char tochar width))) (message "%d lines replaced." found)))) @@ -4169,7 +4548,7 @@ cand replace with char: ") "Join lines in current paragraph into one line, removing end-of-lines." (interactive) (let ((fill-column 65000)) ; Some big number. - (call-interactively 'fill-paragraph))) + (call-interactively #'fill-paragraph))) ;; FIXME: Unbound command - should be bound or removed. (defun rst-force-fill-paragraph () @@ -4228,12 +4607,12 @@ column is used (fill-column vs. end of previous/next line)." ;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex ;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc -;; LocalWords: XML PNT propertized +;; LocalWords: XML PNT propertized init referenceable + +(provide 'rst) ;; Local Variables: -;; sentence-end-double-space: t +;; sentence-end-double-space: t ;; End: -(provide 'rst) - ;;; rst.el ends here diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index c9ba0a9bb54..97a11443984 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -32,6 +32,9 @@ ;;; Code: +(require 'dom) +(require 'seq) +(require 'subr-x) (eval-when-compile (require 'skeleton) (require 'cl-lib)) @@ -338,20 +341,40 @@ Any terminating `>' or `/' is not matched.") (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") -(defconst sgml-syntax-propertize-function +(defun sgml-syntax-propertize (start end) + "Syntactic keywords for `sgml-mode'." + (goto-char start) + (sgml-syntax-propertize-inside end) + (funcall (syntax-propertize-rules ;; Use the `b' style of comments to avoid interference with the -- ... -- ;; comments recognized when `sgml-specials' includes ?-. - ;; FIXME: beware of <!--> blabla <!--> !! + ;; FIXME: beware of <!--> blabla <!--> !! ("\\(<\\)!--" (1 "< b")) - ("--[ \t\n]*\\(>\\)" (1 "> b")) - ;; Double quotes outside of tags should not introduce strings. - ;; Be careful to call `syntax-ppss' on a position before the one we're - ;; going to change, so as not to need to flush the data we just computed. - ("\"" (0 (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) - (goto-char (match-end 0))) - (string-to-syntax "."))))) - "Syntactic keywords for `sgml-mode'.") + ("--[ \t\n]*\\(>\\)" (1 "> b")) + ("\\(<\\)[?!]" (1 (prog1 "|>" + (sgml-syntax-propertize-inside end)))) + ;; Double quotes outside of tags should not introduce strings. + ;; Be careful to call `syntax-ppss' on a position before the one we're + ;; going to change, so as not to need to flush the data we just computed. + ("\"" (0 (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) + (goto-char (match-end 0))) + (string-to-syntax "."))))) + start end)) + +(defun sgml-syntax-propertize-inside (end) + (let ((ppss (syntax-ppss))) + (cond + ((eq (nth 3 ppss) t) + (let ((endre (save-excursion + (goto-char (nth 8 ppss)) + (cond + ((looking-at-p "<!\\[CDATA\\[") "]]>") + ((looking-at-p "<\\?") (if sgml-xml-mode "\\?>" ">")) + (t ">"))))) + (when (re-search-forward endre end 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|<")))))))) ;; internal (defvar sgml-face-tag-alist () @@ -544,7 +567,7 @@ Do \\[describe-key] on the following bindings to discover what they do. sgml-font-lock-keywords-1 sgml-font-lock-keywords-2) nil t)) - (setq-local syntax-propertize-function sgml-syntax-propertize-function) + (setq-local syntax-propertize-function #'sgml-syntax-propertize) (setq-local facemenu-add-face-function 'sgml-mode-facemenu-add-face-function) (setq-local sgml-xml-mode (sgml-xml-guess)) (unless sgml-xml-mode @@ -842,6 +865,25 @@ Return non-nil if we skipped over matched tags." (setq arg (1- arg))) return)) +(defun sgml-forward-sexp (n) + ;; This function is needed in major-modes such as nxml-mode where + ;; forward-sexp-function is used to give a more dwimish behavior to + ;; the `forward-sexp' command. + ;; Without it, we can end up with backtraces like: + ;; "get-text-property" (0xffffc0f0) + ;; "nxml-token-after" (0xffffc2ac) + ;; "nxml-forward-single-balanced-item" (0xffffc46c) + ;; "nxml-forward-balanced-item" (0xffffc61c) + ;; "forward-sexp" (0xffffc7f8) + ;; "sgml-parse-tag-backward" (0xffffc9c8) + ;; "sgml-lexical-context" (0xffffcba8) + ;; "sgml-mode-flyspell-verify" (0xffffcd74) + ;; "flyspell-word" (0xffffcf3c) + ;; "flyspell-post-command-hook" (0xffffd108) + ;; FIXME: should we also set the sgml-tag-syntax-table? + (let ((forward-sexp-function nil)) + (forward-sexp n))) + (defvar sgml-electric-tag-pair-overlays nil) (defvar sgml-electric-tag-pair-timer nil) @@ -862,11 +904,12 @@ Return non-nil if we skipped over matched tags." (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) (with-syntax-table sgml-tag-syntax-table - (up-list -1) - (when (sgml-skip-tag-forward 1) - (backward-sexp 1) - (forward-char 2) - t)))) + (let ((forward-sexp-function nil)) + (up-list -1) + (when (sgml-skip-tag-forward 1) + (backward-sexp 1) + (forward-char 2) + t))))) (clones (get-char-property (point) 'text-clones))) (when (and match (/= cl-end cl-start) @@ -1066,9 +1109,9 @@ With prefix argument ARG, repeat this ARG times." ((and (eq (char-before) ?>) (or (not (eq (char-after) ?<)) (> x y))) - (backward-sexp)) + (sgml-forward-sexp -1)) ((eq (char-after y) ?<) - (forward-sexp))) + (sgml-forward-sexp 1))) (point)))) (message "Invisible tag: %s" ;; Strip properties, otherwise, the text is invisible. @@ -1235,7 +1278,7 @@ You might want to turn on `auto-fill-mode' to get better results." (unless (or ;;(looking-at "</") (progn (skip-chars-backward " \t") (bolp))) (reindent-then-newline-and-indent)) - (forward-sexp 1))) + (sgml-forward-sexp 1))) ;; (indent-region beg end) )) @@ -1281,7 +1324,7 @@ Leave point at the beginning of the tag." (let ((pos (point))) (condition-case nil ;; FIXME: This does not correctly skip over PI an CDATA tags. - (forward-sexp) + (sgml-forward-sexp 1) (scan-error ;; This < seems to be just a spurious one, let's ignore it. (goto-char pos) @@ -1315,7 +1358,7 @@ Leave point at the beginning of the tag." (with-syntax-table sgml-tag-syntax-table (goto-char tag-end) (condition-case nil - (backward-sexp) + (sgml-forward-sexp -1) (scan-error ;; This > isn't really the end of a tag. Skip it. (goto-char (1- tag-end)) @@ -1540,7 +1583,7 @@ LCON is the lexical context, if any." (`text (while (looking-at "</") - (forward-sexp 1) + (sgml-forward-sexp 1) (skip-chars-forward " \t")) (let* ((here (point)) (unclosed (and ;; (not sgml-xml-mode) @@ -1759,11 +1802,12 @@ This takes effect when first loading the library.") "Value of `sgml-display-text' for HTML mode.") -;; should code exactly HTML 3 here when that is finished (defvar html-tag-alist (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7"))) (1-9 `(,@1-7 ("8") ("9"))) (align '(("align" ("left") ("center") ("right")))) + (ialign '(("align" ("top") ("middle") ("bottom") ("left") + ("right")))) (valign '(("top") ("middle") ("bottom") ("baseline"))) (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") @@ -1776,17 +1820,29 @@ This takes effect when first loading the library.") ("title"))) (list '((nil \n ("List item: " "<li>" str (if sgml-xml-mode "</li>") \n)))) + (shape '(("shape" ("rect") ("circle") ("poly") ("default")))) (cell `(t ,@align ("valign" ,@valign) ("colspan" ,@1-9) ("rowspan" ,@1-9) - ("nowrap" t)))) + ("nowrap" t))) + (cellhalign '(("align" ("left") ("center") ("right") + ("justify") ("char")) + ("char") ("charoff"))) + (cellvalign '(("valign" ("top") ("middle") ("bottom") + ("baseline"))))) ;; put ,-expressions first, else byte-compile chokes (as of V19.29) ;; and like this it's more efficient anyway `(("a" ,name ,@link) + ("area" t ,@shape ("coords") ("href") ("nohref" "nohref") ("alt") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) ("base" t ,@href) + ("col" t ,@cellhalign ,@cellvalign ("span") ("width")) + ("colgroup" \n ,@cellhalign ,@cellvalign ("span") ("width")) ("dir" ,@list) + ("figcaption") + ("figure" \n) ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7) ("form" (\n _ \n "<input type=\"submit\" value=\"\"" (if sgml-xml-mode " />" ">")) @@ -1798,13 +1854,28 @@ This takes effect when first loading the library.") ("h5" ,@align) ("h6" ,@align) ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align) + ("iframe" \n ,@ialign ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("scrolling" ("yes") ("no") ("auto")) ("height") ("width")) ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom")) ("src") ("alt") ("width" "1") ("height" "1") ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t)) - ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name - ("type" ("text") ("password") ("checkbox") ("radio") - ("submit") ("reset")) - ("value")) + ("input" t ,name ("accept") ("alt") ("autocomplete" ("on") ("off")) + ("autofocus" t) ("checked" t) ("dirname") ("disabled" t) ("form") + ("formaction") + ("formenctype" ("application/x-www-form-urlencoded") + ("multipart/form-data") ("text/plain")) + ("formmethod" ("get") ("post")) + ("formnovalidate" t) + ("formtarget" ("_blank") ("_self") ("_parent") ("_top")) + ("height") ("inputmode") ("list") ("max") ("maxlength") ("min") + ("minlength") ("multiple" t) ("pattern") ("placeholder") + ("readonly" t) ("required" t) ("size") ("src") ("step") + ("type" ("hidden") ("text") ("search") ("tel") ("url") ("email") + ("password") ("date") ("time") ("number") ("range") ("color") + ("checkbox") ("radio") ("file") ("submit") ("image") ("reset") + ("button")) + ("value") ("width")) ("link" t ,@link) ("menu" ,@list) ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1"))) @@ -1819,14 +1890,17 @@ This takes effect when first loading the library.") "<tr><" str ?> _ (if sgml-xml-mode (concat "<" str "></tr>")) \n)) ("border" t ,@1-9) ("width" "10") ("cellpadding")) + ("tbody" \n ,@cellhalign ,@cellvalign) ("td" ,@cell) ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9)) + ("tfoot" \n ,@cellhalign ,@cellvalign) ("th" ,@cell) + ("thead" \n ,@cellhalign ,@cellvalign) ("ul" ,@list ("type" ("disc") ("circle") ("square"))) ,@sgml-tag-alist - ("abbrev") + ("abbr") ("acronym") ("address") ("array" (nil \n @@ -1835,20 +1909,33 @@ This takes effect when first loading the library.") ("article" \n) ("aside" \n) ("au") + ("audio" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls")) ("b") + ("bdi") + ("bdo" nil ("lang") ("dir" ("ltr") ("rtl"))) ("big") ("blink") - ("blockquote" \n) + ("blockquote" \n ("cite")) ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#") ("link" "#") ("alink" "#") ("vlink" "#")) ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>"))) ("br" t ("clear" ("left") ("right"))) + ("button" nil ("name") ("value") + ("type" ("submit") ("reset") ("button")) + ("disabled" "disabled") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) + ("canvas" \n ("width") ("height")) ("caption" ("valign" ("top") ("bottom"))) ("center" \n) ("cite") ("code" \n) + ("datalist" \n) ("dd" ,(not sgml-xml-mode)) - ("del") + ("del" nil ("cite") ("datetime")) ("dfn") ("div") ("dl" (nil \n @@ -1858,14 +1945,20 @@ This takes effect when first loading the library.") ("dt" (t _ (if sgml-xml-mode "</dt>") "<dd>" (if sgml-xml-mode "</dd>") \n)) ("em") + ("embed" t ("src") ("type") ("width") ("height")) + ("fieldset" \n) ("fn" "id" "fn") ;; Footnotes were deprecated in HTML 3.2 ("footer" \n) + ("frame" t ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("noresize" "noresize") ("scrolling" ("yes") ("no") ("auto"))) + ("frameset" \n ("rows") ("cols") ("onload") ("onunload")) ("head" \n) ("header" \n) ("hgroup" \n) ("html" (\n "<head>\n" - "<title>" (setq str (read-input "Title: ")) "</title>\n" + "<title>" (setq str (read-string "Title: ")) "</title>\n" "</head>\n" "<body>\n<h1>" str "</h1>\n" _ "\n<address>\n<a href=\"mailto:" @@ -1874,24 +1967,49 @@ This takes effect when first loading the library.") "</body>" )) ("i") - ("ins") + ("ins" nil ("cite") ("datetime")) ("isindex" t ("action") ("prompt")) ("kbd") + ("label" nil ("for") ("accesskey") ("onfocus") ("onblur")) ("lang") + ("legend" nil ("accesskey")) ("li" ,(not sgml-xml-mode)) + ("main" \n) + ("map" \n ("name")) + ("mark") ("math" \n) + ("meta" t ("http-equiv") ("name") ("content") ("scheme")) + ("meter" nil ("value") ("min") ("max") ("low") ("high") + ("optimum")) ("nav" \n) ("nobr") + ("noframes" \n) + ("noscript" \n) + ("object" \n ("declare" "declare") ("classid") ("codebase") + ("data") ("type") ("codetype") ("archive") ("standby") + ("height") ("width") ("usemap") ("name") ("tabindex")) + ("optgroup" \n ("name") ("size") ("multiple" "multiple") + ("disabled" "disabled") ("tabindex") ("onfocus") ("onblur") + ("onchange")) ("option" t ("value") ("label") ("selected" t)) + ("output" nil ("for") ("form") ("name")) ("over" t) + ("param" t ("name") ("value") + ("valuetype" ("data") ("ref") ("object")) ("type")) ("person") ;; Tag for person's name tag deprecated in HTML 3.2 ("pre" \n) - ("q") + ("progress" nil ("value") ("max")) + ("q" nil ("cite")) ("rev") + ("rp" t) + ("rt" t) + ("ruby") ("s") ("samp") + ("script" nil ("charset") ("type") ("src") ("defer" "defer")) ("section" \n) ("small") + ("source" t ("src") ("type") ("media")) ("span" nil ("class" ("builtin") @@ -1904,39 +2022,60 @@ This takes effect when first loading the library.") ("variable-name") ("warning"))) ("strong") + ("style" \n ("type") ("media") ("title")) ("sub") + ("summary") ("sup") + ("time" nil ("datetime")) ("title") ("tr" t) + ("track" t + ("kind" ("subtitles") ("captions") ("descriptions") + ("chapters") ("metadata")) + ("src") ("srclang") ("label") ("default")) ("tt") ("u") ("var") + ("video" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("poster") ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls") ("width") ("height")) ("wbr" t))) "Value of `sgml-tag-alist' for HTML mode.") (defvar html-tag-help `(,@sgml-tag-help ("a" . "Anchor of point or link elsewhere") - ("abbrev" . "Abbreviation") + ("abbr" . "Abbreviation") ("acronym" . "Acronym") ("address" . "Formatted mail address") + ("area" . "Region of an image map") ("array" . "Math array") ("article" . "An independent part of document or site") ("aside" . "Secondary content related to surrounding content (e.g. page or article)") ("au" . "Author") + ("audio" . "Sound or audio stream") ("b" . "Bold face") ("base" . "Base address for URLs") + ("bdi" . "Text isolated for bidirectional formatting") + ("bdo" . "Override text directionality") ("big" . "Font size") ("blink" . "Blinking text") ("blockquote" . "Indented quotation") ("body" . "Document body") ("box" . "Math fraction") ("br" . "Line break") + ("button" . "Clickable button") + ("canvas" . "Script generated graphics canvas") ("caption" . "Table caption") ("center" . "Centered text") ("changed" . "Change bars") ("cite" . "Citation of a document") ("code" . "Formatted source code") + ("col" . "Group of attribute specifications for table columns") + ("colgroup" . "Group of columns") + ("datalist" . "A set of predefined options") ("dd" . "Definition of term") ("del" . "Deleted text") ("dfn" . "Defining instance of a term") @@ -1946,14 +2085,19 @@ This takes effect when first loading the library.") ("dt" . "Term to be defined") ("em" . "Emphasized") ("embed" . "Embedded data in foreign format") + ("fieldset" . "Group of related controls and labels") ("fig" . "Figure") ("figa" . "Figure anchor") + ("figcaption" . "Caption for a figure") ("figd" . "Figure description") ("figt" . "Figure text") + ("figure" . "Self-contained content, often with a caption") ("fn" . "Footnote") ;; No one supports special footnote rendering. ("font" . "Font size") ("footer" . "Footer of a section") ("form" . "Form with input fields") + ("frame" . "Frame in which another HTML document can be displayed") + ("frameset" . "Container for frames") ("group" . "Document grouping") ("h1" . "Most important section headline") ("h2" . "Important section headline") @@ -1967,50 +2111,78 @@ This takes effect when first loading the library.") ("hr" . "Horizontal rule") ("html" . "HTML Document") ("i" . "Italic face") + ("iframe" . "Inline frame with a nested browsing context") ("img" . "Graphic image") ("input" . "Form input field") ("ins" . "Inserted text") ("isindex" . "Input field for index search") ("kbd" . "Keyboard example face") + ("label" . "Caption for a user interface item") ("lang" . "Natural language") + ("legend" . "Caption for a fieldset") ("li" . "List item") ("link" . "Link relationship") + ("main" . "Main content of the document body") + ("map" . "Image map (a clickable link area") + ("mark" . "Highlighted text") ("math" . "Math formula") ("menu" . "List of commands") + ("meta" . "Document properties") + ("meter" . "Scalar measurement within a known range") ("mh" . "Form mail header") ("nav" . "Group of navigational links") ("nextid" . "Allocate new id") ("nobr" . "Text without line break") + ("noframes" . "Content for user agents that don't support frames") + ("noscript" . "Alternate content for when a script isn't executed") + ("object" . "External resource") ("ol" . "Ordered list") + ("optgroup" . "Group of options") ("option" . "Selection list item") + ("output" . "Result of a calculation or user action") ("over" . "Math fraction rule") ("p" . "Paragraph start") ("panel" . "Floating panel") + ("param" . "Parameters for an object") ("person" . "Person's name") ("pre" . "Preformatted fixed width text") + ("progress" . "Completion progress of a task") ("q" . "Quotation") ("rev" . "Reverse video") + ("rp" . "Fallback text for when ruby annotations aren't supported") + ("rt" . "Ruby text component of a ruby annotation") + ("ruby" . "Ruby annotation") ("s" . "Strikeout") ("samp" . "Sample text") + ("script" . "Executable script within a document") ("section" . "Section of a document") ("select" . "Selection list") ("small" . "Font size") + ("source" . "Media resource for media elements") ("sp" . "Nobreak space") ("span" . "Generic inline container") ("strong" . "Standout text") + ("style" . "Style information") ("sub" . "Subscript") + ("summary" . "Summary, caption, or legend") ("sup" . "Superscript") ("table" . "Table with rows and columns") ("tb" . "Table vertical break") + ("tbody" . "Table body") ("td" . "Table data cell") ("textarea" . "Form multiline edit area") + ("tfoot" . "Table foot") ("th" . "Table header cell") + ("thead" . "Table head") + ("time" . "Content with optional machine-readable timestamp") ("title" . "Document title") ("tr" . "Table row separator") + ("track" . "Timed text track for media elements") ("tt" . "Typewriter face") ("u" . "Underlined text") ("ul" . "Unordered list") ("var" . "Math variable face") + ("video" . "Video or movie") ("wbr" . "Enable <br> within <nobr>")) "Value of variable `sgml-tag-help' for HTML mode.") @@ -2031,6 +2203,55 @@ This takes effect when first loading the library.") nil t) (match-string-no-properties 1)))) +(defvar html--buffer-classes-cache nil + "Cache for `html-current-buffer-classes'. +When set, this should be a cons cell where the CAR is the +buffer's tick counter (as produced by `buffer-modified-tick'), +and the CDR is the list of class names found in the buffer.") +(make-variable-buffer-local 'html--buffer-classes-cache) + +(defvar html--buffer-ids-cache nil + "Cache for `html-current-buffer-ids'. +When set, this should be a cons cell where the CAR is the +buffer's tick counter (as produced by `buffer-modified-tick'), +and the CDR is the list of class names found in the buffer.") +(make-variable-buffer-local 'html--buffer-ids-cache) + +(defun html-current-buffer-classes () + "Return a list of class names used in the current buffer. +The result is cached in `html--buffer-classes-cache'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-classes-cache) tick) + (cdr html--buffer-classes-cache) + (let* ((dom (libxml-parse-html-region (point-min) (point-max))) + (classes + (seq-mapcat + (lambda (el) + (when-let (class-list + (cdr (assq 'class (dom-attributes el)))) + (split-string class-list))) + (dom-by-class dom "")))) + (setq-local html--buffer-classes-cache (cons tick classes)) + classes)))) + +(defun html-current-buffer-ids () + "Return a list of IDs used in the current buffer. +The result is cached in `html--buffer-ids-cache'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-ids-cache) tick) + (cdr html--buffer-ids-cache) + (let* ((dom + (libxml-parse-html-region (point-min) (point-max))) + (ids + (seq-mapcat + (lambda (el) + (when-let (id-list + (cdr (assq 'id (dom-attributes el)))) + (split-string id-list))) + (dom-by-id dom "")))) + (setq-local html--buffer-ids-cache (cons tick ids)) + ids)))) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") @@ -2081,6 +2302,12 @@ To work around that, do: (setq-local add-log-current-defun-function #'html-current-defun-name) (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*") + (when (fboundp 'libxml-parse-html-region) + (defvar css-class-list-function) + (setq-local css-class-list-function #'html-current-buffer-classes) + (defvar css-id-list-function) + (setq-local css-id-list-function #'html-current-buffer-ids)) + (setq imenu-create-index-function 'html-imenu-index) (setq-local sgml-empty-tags diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 54a3d96d6e8..5e967b535c4 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -641,7 +641,7 @@ "Text based table manipulation utilities." :tag "Table" :prefix "table-" - :group 'wp + :group 'text :version "22.1") (defgroup table-hooks nil @@ -936,6 +936,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu ([(shift backtab)] . table-backward-cell) ; for HPUX console keyboard ([(shift iso-lefttab)] . table-backward-cell) ; shift-tab on a microsoft natural keyboard and redhat linux ([(shift tab)] . table-backward-cell) + ([backtab] . table-backward-cell) ; for terminals (e.g., xterm) ([return] . *table--cell-newline) ([(control m)] . *table--cell-newline) ([(control j)] . *table--cell-newline-and-indent) @@ -2967,8 +2968,7 @@ CALS (DocBook DTD): (default (car table-source-language-history)) (language (downcase (completing-read (format "Language (default %s): " default) - (mapcar (lambda (s) (list (symbol-name s))) - table-source-languages) + table-source-languages nil t nil 'table-source-language-history default)))) (list (intern language) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 6c3687d3524..ba6d696de90 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -343,7 +343,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (defun latex-imenu-create-index () "Generate an alist for imenu from a LaTeX buffer." (let ((section-regexp - (concat "\\\\" (regexp-opt (mapcar 'car latex-section-alist) t) + (concat "\\\\" (regexp-opt (mapcar #'car latex-section-alist) t) "\\*?[ \t]*{")) (metasection-regexp (concat "\\\\" (regexp-opt latex-metasection-list t))) @@ -373,7 +373,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; Using sexps allows some use of matching {...} inside ;; titles. (forward-sexp 1) - (push (cons (concat (apply 'concat + (push (cons (concat (apply #'concat (make-list (max 0 (- i i0)) latex-imenu-indent-string)) @@ -413,7 +413,8 @@ An alternative value is \" . \", if you use a font with a narrow period." (defvar latex-outline-regexp (concat "\\\\" (regexp-opt (append latex-metasection-list - (mapcar 'car latex-section-alist)) t))) + (mapcar #'car latex-section-alist)) + t))) (defun latex-outline-level () (if (looking-at latex-outline-regexp) @@ -504,7 +505,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (funcall inbraces-re (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) "*}\\)+\\$?\\$") - (0 tex-math-face)) + (0 'tex-math)) ;; Heading args. (,(concat slash headings "\\*?" opt arg) ;; If ARG ends up matching too much (if the {} don't match, e.g.) @@ -544,7 +545,8 @@ An alternative value is \" . \", if you use a font with a narrow period." (let* (;; ;; Names of commands whose arg should be fontified with fonts. (bold (regexp-opt '("textbf" "textsc" "textup" - "boldsymbol" "pmb") t)) + "boldsymbol" "pmb") + t)) (italic (regexp-opt '("textit" "textsl" "emph") t)) ;; FIXME: unimplemented yet. ;; (type (regexp-opt '("texttt" "textmd" "textrm" "textsf") t)) @@ -566,7 +568,8 @@ An alternative value is \" . \", if you use a font with a narrow period." '("linebreak" "nolinebreak" "pagebreak" "nopagebreak" "newline" "newpage" "clearpage" "cleardoublepage" "displaybreak" "allowdisplaybreaks" - "enlargethispage") t)) + "enlargethispage") + t)) (general "\\([a-zA-Z@]+\\**\\|[^ \t\n]\\)") ;; ;; Miscellany. @@ -649,7 +652,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (defvar tex-verbatim-environments '("verbatim" "verbatim*")) (put 'tex-verbatim-environments 'safe-local-variable - (lambda (x) (null (delq t (mapcar 'stringp x))))) + (lambda (x) (null (delq t (mapcar #'stringp x))))) (eval-when-compile (defconst tex-syntax-propertize-rules @@ -797,15 +800,11 @@ Not smaller than the value set by `tex-suscript-height-minimum'." '((t :inherit font-lock-string-face)) "Face used to highlight TeX math expressions." :group 'tex) -(define-obsolete-face-alias 'tex-math-face 'tex-math "22.1") -(defvar tex-math-face 'tex-math) (defface tex-verbatim '((t :inherit fixed-pitch-serif)) "Face used to highlight TeX verbatim environments." :group 'tex) -(define-obsolete-face-alias 'tex-verbatim-face 'tex-verbatim "22.1") -(defvar tex-verbatim-face 'tex-verbatim) (defun tex-font-lock-verb (start delim) "Place syntax table properties on the \\verb construct. @@ -833,10 +832,10 @@ START is the position of the \\ and DELIM is the delimiter char." (let ((char (nth 3 state))) (cond ((not char) - (if (eq 2 (nth 7 state)) tex-verbatim-face font-lock-comment-face)) - ((eq char ?$) tex-math-face) + (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) + ((eq char ?$) 'tex-math) ;; A \verb element. - (t tex-verbatim-face)))) + (t 'tex-verbatim)))) (defun tex-define-common-keys (keymap) @@ -1128,34 +1127,36 @@ subshell is initiated, `tex-shell-hook' is run." (concat "[ \t]*\\(\\$\\$\\|" "\\\\[][]\\|" "\\\\" (regexp-opt (append - (mapcar 'car latex-section-alist) + (mapcar #'car latex-section-alist) '("begin" "label" "end" "item" "bibitem" "newline" "noindent" "newpage" "footnote" "marginpar" - "parbox" "caption")) t) + "parbox" "caption")) + t) "\\>\\|\\\\[a-z]*" (regexp-opt '("space" "skip" "page") t) "\\>\\)")) (setq paragraph-separate (concat "[\f%]\\|[ \t]*\\($\\|" "\\\\[][]\\|" "\\\\" (regexp-opt (append - (mapcar 'car latex-section-alist) - '("begin" "label" "end" )) t) + (mapcar #'car latex-section-alist) + '("begin" "label" "end" )) + t) "\\>\\|\\\\\\(" (regexp-opt '("item" "bibitem" "newline" "noindent" "newpage" "footnote" "marginpar" "parbox" "caption")) "\\|\\$\\$\\|[a-z]*\\(space\\|skip\\|page[a-z]*\\)" "\\>\\)[ \t]*\\($\\|%\\)\\)")) - (setq-local imenu-create-index-function 'latex-imenu-create-index) + (setq-local imenu-create-index-function #'latex-imenu-create-index) (setq-local tex-face-alist tex-latex-face-alist) - (add-hook 'fill-nobreak-predicate 'latex-fill-nobreak-predicate nil t) - (setq-local indent-line-function 'latex-indent) + (add-hook 'fill-nobreak-predicate #'latex-fill-nobreak-predicate nil t) + (setq-local indent-line-function #'latex-indent) (setq-local fill-indent-according-to-mode t) (add-hook 'completion-at-point-functions - 'latex-complete-data nil 'local) + #'latex-complete-data nil 'local) (setq-local outline-regexp latex-outline-regexp) - (setq-local outline-level 'latex-outline-level) - (setq-local forward-sexp-function 'latex-forward-sexp) + (setq-local outline-level #'latex-outline-level) + (setq-local forward-sexp-function #'latex-forward-sexp) (setq-local skeleton-end-hook nil)) ;;;###autoload @@ -1205,6 +1206,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (defvar tildify-space-string) (defvar tildify-foreach-region-function) +(declare-function tildify-foreach-ignore-environments + "tildify" (pairs callback _beg end)) (defvar tex--prettify-symbols-alist) (defun tex-common-initialization () @@ -1216,7 +1219,7 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook ;; rather than using regex-based filtering. (setq-local tildify-foreach-region-function (apply-partially - 'tildify-foreach-ignore-environments + #'tildify-foreach-ignore-environments `(("\\\\\\\\" . "") ; do not remove this (,(eval-when-compile (concat "\\\\begin{\\(" @@ -1308,6 +1311,7 @@ inserts \" characters." ;; (if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\)) (eq (get-text-property (point) 'face) 'tex-verbatim) + (nth 4 (syntax-ppss)) ; non-nil if point is in a TeX comment ;; Discover if a preceding occurrence of `tex-open-quote' ;; should be morphed to a normal double quote. ;; @@ -1545,8 +1549,7 @@ a skeleton (see `skeleton-insert').") Puts point on a blank line between them." (let ((choice (completing-read (format "LaTeX block name [%s]: " latex-block-default) - (append latex-block-names - latex-standard-block-names) + (latex-complete-envnames) nil nil nil nil latex-block-default))) (setq latex-block-default choice) (unless (or (member choice latex-standard-block-names) @@ -1603,17 +1606,32 @@ Puts point on a blank line between them." (complete-with-action action keys key pred))))) (defun latex-complete-envnames () - (append latex-block-names latex-standard-block-names)) + (completion-table-in-turn + (append latex-block-names latex-standard-block-names) + (completion-table-dynamic + (lambda (str) + (with-current-buffer (if (and (minibufferp) (minibuffer-selected-window)) + (window-buffer (minibuffer-selected-window)) + (current-buffer)) + (save-excursion + (let ((comps '()) + (pos (point))) + (goto-char (point-min)) + (while (re-search-forward (concat "\\\\begin{\\(" str "[^}\n ]*\\)") + nil t) + (unless (and (<= (match-beginning 0) pos) + (>= (match-end 0) pos)) + (push (match-string 1) comps))) + comps))))))) (defun latex-complete-refkeys () (when (boundp 'reftex-docstruct-symbol) (symbol-value reftex-docstruct-symbol))) (defvar latex-complete-alist - ;; TODO: Add \begin, \end, \ref, ... - '(("\\`\\\\\\(short\\)?cite\\'" . latex-complete-bibtex-keys) - ("\\`\\\\\\(begin\\|end\\)\\'" . latex-complete-envnames) - ("\\`\\\\[vf]?ref\\'" . latex-complete-refkeys))) + `(("\\`\\\\\\(short\\)?cite\\'" . ,#'latex-complete-bibtex-keys) + ("\\`\\\\\\(begin\\|end\\)\\'" . ,#'latex-complete-envnames) + ("\\`\\\\[vf]?ref\\'" . ,#'latex-complete-refkeys))) (defun latex-complete-data () "Get completion-data at point." @@ -2095,13 +2113,17 @@ If NOT-ALL is non-nil, save the `.dvi' file." :group 'tex) (defvar tex-compile-commands - '(((concat "pdf" tex-command - " " (if (< 0 (length tex-start-commands)) - (shell-quote-argument tex-start-commands)) " %f") - t "%r.pdf") + `(,@(mapcar (lambda (prefix) + `((concat ,prefix tex-command + " " (if (< 0 (length tex-start-commands)) + (shell-quote-argument tex-start-commands)) + " %f") + t "%r.pdf")) + '("pdf" "xe" "lua")) ((concat tex-command " " (if (< 0 (length tex-start-commands)) - (shell-quote-argument tex-start-commands)) " %f") + (shell-quote-argument tex-start-commands)) + " %f") t "%r.dvi") ("xdvi %r &" "%r.dvi") ("\\doc-view \"%r.pdf\"" "%r.pdf") @@ -2196,7 +2218,7 @@ of the current buffer." (defun tex-summarize-command (cmd) (if (not (stringp cmd)) "" - (mapconcat 'identity + (mapconcat #'identity (mapcar (lambda (s) (car (split-string s))) (split-string cmd "\\s-*\\(?:;\\|&&\\)\\s-*")) "&"))) @@ -2378,7 +2400,8 @@ Only applies the FSPEC to the args part of FORMAT." ;; Substitute and return. (if (and hist-cmd (string-match (concat "[' \t\"]" (format-spec "%r" fspec) - "\\([;&' \t\"]\\|\\'\\)") hist-cmd)) + "\\([;&' \t\"]\\|\\'\\)") + hist-cmd)) ;; The history command was already applied to the same file, ;; so just reuse it. hist-cmd @@ -2763,7 +2786,7 @@ Runs the shell command defined by `tex-show-queue-command'." (defvar tex-indent-item-re "\\\\\\(bib\\)?item\\>") (defvar latex-noindent-environments '("document")) (put 'latex-noindent-environments 'safe-local-variable - (lambda (x) (null (delq t (mapcar 'stringp x))))) + (lambda (x) (null (delq t (mapcar #'stringp x))))) (defvar tex-latex-indent-syntax-table (let ((st (make-syntax-table tex-mode-syntax-table))) @@ -2983,7 +3006,7 @@ There might be text before point." ("\\sigma" . ?σ) ("\\tau" . ?τ) ("\\upsilon" . ?υ) - ("\\phi" . ?φ) + ("\\phi" . ?ϕ) ("\\chi" . ?χ) ("\\psi" . ?ψ) ("\\omega" . ?ω) @@ -3372,10 +3395,11 @@ There might be text before point." ("\\u{i}" . ?ĭ) ("\\vDash" . ?⊨) ("\\varepsilon" . ?ε) + ("\\varphi" . ?φ) ("\\varprime" . ?′) ("\\varpropto" . ?∝) ("\\varrho" . ?ϱ) - ;; ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var. + ("\\varsigma" ?ς) ("\\vartriangleleft" . ?⊲) ("\\vartriangleright" . ?⊳) ("\\vdash" . ?⊢) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 58d5ce7a08a..f962dec9f09 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -351,8 +351,6 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") '((t (:inherit font-lock-function-name-face))) "Face used for section headings in `texinfo-mode'." :group 'texinfo) -(define-obsolete-face-alias 'texinfo-heading-face 'texinfo-heading "22.1") -(defvar texinfo-heading-face 'texinfo-heading) (defvar texinfo-font-lock-keywords `(;; All but the first had an OVERRIDE of t. @@ -368,8 +366,10 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") ;; their arguments frequently include a @@, and we don't want that ;; to overwrite the normal fontification of the argument. ("@\\(file\\|email\\){\\([^}]+\\)" 2 font-lock-string-face keep) - ("@\\(samp\\|code\\|var\\|math\\|env\\|command\\|option\\){\\([^}]+\\)" + ("@\\(samp\\|code\\|var\\|env\\|command\\|option\\){\\([^}]+\\)" 2 font-lock-variable-name-face keep) + ;; @math allows nested braces like @math{2^{12}} + ("@math{\\([^{}]*{?[^{}]*}?[^{}]*\\)}" 1 font-lock-variable-name-face) ("@\\(cite\\|x?ref\\|pxref\\|dfn\\|inforef\\){\\([^}]+\\)" 2 font-lock-constant-face) ("@\\(anchor\\){\\([^}]+\\)" 2 font-lock-type-face) @@ -378,7 +378,8 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") ;; (,texinfo-environment-regexp ;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep) (,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t) - ".*\n") 0 texinfo-heading-face t)) + ".*\n") + 0 'texinfo-heading t)) "Additional expressions to highlight in Texinfo mode.") (defun texinfo-clone-environment (start end) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index dd5fdfe658b..7d63556dcc2 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -35,7 +35,7 @@ "Normal hook run when entering Text mode and many related modes." :type 'hook :options '(turn-on-auto-fill turn-on-flyspell) - :group 'wp) + :group 'text) (defvar text-mode-variant nil "Non-nil if this buffer's major mode is a variant of Text mode. @@ -232,4 +232,6 @@ The argument NLINES says how many lines to center." (setq nlines (1+ nlines)) (forward-line -1))))) +(provide 'text-mode) + ;;; text-mode.el ends here diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 56d75374232..e4920b70c1c 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -54,7 +54,7 @@ (defgroup tildify nil "Add hard spaces or other text fragments to text buffers." :version "21.1" - :group 'wp) + :group 'text) (defcustom tildify-pattern "\\(?:[,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(?:\\w\\|[([{\\]\\|<[a-zA-Z]\\)" |