diff options
Diffstat (limited to 'lisp/textmodes')
29 files changed, 3047 insertions, 3039 deletions
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 62b666b2524..8b40558e3a4 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/css-mode.el b/lisp/textmodes/css-mode.el index b3a41d3822c..9e36a881a3e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -29,11 +29,14 @@ ;; - electric ; and } ;; - filling code with auto-fill-mode -;; - attribute value completion ;; - fix font-lock errors with multi-line selectors ;;; Code: +(require 'seq) +(require 'sgml-mode) +(require 'smie) + (defgroup css nil "Cascading Style Sheets (CSS) editing mode." :group 'languages) @@ -51,9 +54,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 +76,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 +92,504 @@ "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)) + "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" @@ -243,9 +655,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 @@ -321,8 +731,6 @@ :type 'integer :safe 'integerp) -(require 'smie) - (defconst css-smie-grammar (smie-prec2->grammar (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) @@ -377,6 +785,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 +810,121 @@ (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) + `(,@(if prop-table + (list prop-beg prop-end) + (list sel-beg sel-end)) + ,(completion-table-merge prop-table sel-table))))))) ;;;###autoload (define-derived-mode css-mode prog-mode "CSS" @@ -533,9 +1055,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 +1080,11 @@ 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))) (provide 'css-mode) ;;; css-mode.el ends here diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 124be27f4f3..5562a75340a 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 100e2a24367..173d1c9d196 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -804,65 +804,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 730b55fbd8f..bfe839ac77e 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)))) @@ -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." @@ -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 0cedf86bb73..7551d2fde97 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-2016 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 @@ -3638,7 +3338,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 +3572,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 +3806,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 +3838,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 +4078,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 +4105,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 +4121,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 +4159,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 b064f6d2b31..35996bc2509 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 4769af5a1d1..f67e85e8432 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 b77f8e9717c..01d67b5c1dd 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 b73916a22d6..46bf3c7552b 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 f2abf06ebdc..4c9e62bb4c8 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 c3f39ecd327..8efe8a2ec19 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 0a3e7a48356..fd7915ccc76 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 9d4ee086db1..65742f36f78 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 7f27158d257..c8c62a0d944 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 c5c3885b167..4dd190d2b0f 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 5f969f4effd..9180bea3d3b 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) @@ -306,7 +306,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 +608,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 +672,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 +841,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 +984,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 +1057,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 +1081,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 +1091,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 +1131,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 32703591cad..fdde4aa0541 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 f46c2370d71..d3a7ee49804 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 e96e822fd0f..a4c8da07501 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 @@ -942,17 +934,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 +1103,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 d1a6b87da2e..11dcdd5a183 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,22 @@ 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}") + (?y . "\\citeyear{%l}") + (?Y . "\\citeyear*{%l}") + (?n . "\\nocite{%l}"))) (amsrefs "The AMSRefs package" ((?\C-m . "\\cite{%l}") (?p . "\\cite{%l}") @@ -1076,9 +1092,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 ae9db7de10a..adc5076daf1 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. @@ -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 @@ -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" "32dc44348a7eaf247f63c81b3ead2ba4") -;;; 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" "7ee48dcf194ffd3cce3b7a2eb990e300") -;;; 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" "8a1cb9d9c9190eefd4e22ab89d278e03") -;;; 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" "a7a6a1872e4509da5b211972c2a588ad") -;;; 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" "0e0eef2a199fb9de6f13b5eef601843f") -;;; 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" "9015d91c86a135c850f92b828eca6b62") -;;; 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" "b2ce366d12050904d89cc38b96b8058a") -;;; 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" "b5e68431056b461d8a0562e9e685a5f1") -;;; 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" "af8f426ef3a0607322ca4c9742e177a8") -;;; 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 aea8e7072ea..7161dd329ac 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2003-2016 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 @@ -110,10 +105,10 @@ ;; 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'. +;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by +;; a comment tagged with `testcover' after the `defun'. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -160,6 +155,7 @@ considered constants. Revert it with this function after each `defcustom'." ;; used from there. (defun rst-signum (x) + ;; testcover: ok. "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) @@ -167,6 +163,7 @@ considered constants. Revert it with this function after each `defcustom'." (t 0))) (defun rst-some (seq &optional pred) + ;; testcover: ok. "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 @@ -180,6 +177,7 @@ result is yielded and return this result. PRED defaults to (throw 'rst-some r)))))) (defun rst-position-if (pred seq) + ;; testcover: ok. "Return position of first element satisfying PRED in list SEQ or nil." (catch 'rst-position-if (let ((i 0)) @@ -189,6 +187,7 @@ result is yielded and return this result. PRED defaults to (incf i))))) (defun rst-position (elem seq) + ;; testcover: ok. "Return position of ELEM in list SEQ or nil. Comparison done with `equal'." ;; Create a closure containing `elem' so the `lambda' always sees our @@ -199,13 +198,22 @@ Comparison done with `equal'." (equal elem e))) seq))) -;; FIXME: Embed complicated `defconst's in `eval-when-compile'. +(defun rst-member-if (pred seq) + ;; testcover: ok. + "Return sublist of SEQ starting with the element whose car satisfies PRED." + (let (found) + (while (and (not found) seq) + (if (funcall pred (car seq)) + (setq found seq) + (setq seq (cdr seq)))) + found)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 +226,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.600 2016/07/31 11:13:44 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -232,22 +240,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: 7963 $") "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: 2016-07-31 13:13:21 +0200 (Sun, 31 Jul 2016) $") "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.0 %") "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.600 %") "CVS revision of this file in the official version.") (defconst rst-version @@ -268,6 +276,8 @@ in parentheses follows the development revision and the time stamp.") ("1.3.1" . "24.3") ("1.4.0" . "24.3") ("1.4.1" . "24.5") + ("1.4.2" . "24.5") + ("1.5.0" . "26.1") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -277,12 +287,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")) @@ -490,8 +500,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 +543,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: @@ -603,10 +615,579 @@ After interpretation of ARGS the results are concatenated as for ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 + +(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." + (cond + ((not (characterp char)) + (signal 'wrong-type-argument (list 'characterp char))) + ((memq char rst-adornment-chars) + char) + (t + (signal 'args-out-of-range + (list (format + "Character must be a valid adornment character, not '%s'" + char)))))) + +;; Public methods + +(defun rst-Ado-is-transition (self) + ;; testcover: ok. + "Return non-nil if SELF is a transition adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'transition)) + +(defun rst-Ado-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (not (rst-Ado-is-transition self))) + +(defun rst-Ado-is-simple (self) + ;; testcover: ok. + "Return non-nil if SELF is a simple section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (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." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (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." + (cond + ((not (rst-Ado-p self)) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + ((not (rst-Ado-p other)) + (signal 'wrong-type-argument + (list 'rst-Ado-p other))) + ((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 of SELF in ADOS or nil." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (lexical-let ((ado self)) ;; Create closure. + (rst-position-if (function (lambda (e) + (rst-Ado-equal ado e))) + ados))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Hdr + +(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 rst-Hdr-copy)) ;; 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." + (cond + ((not (integerp indent)) + (signal 'wrong-type-argument + (list 'integerp 'null indent))) + ((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")))) + (indent))) ;; Implicitly over-and-under. + +(defun rst-Hdr--validate-ado (ado) + ;; testcover: ok. + "Validate ADO to be a valid adornment. +Return ADO if so or signal an error otherwise." + (cond + ((not (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'rst-Ado-p ado))) + ((rst-Ado-is-transition ado) + (signal 'args-out-of-range + '("Adornment for header must not be transition."))) + (t + ado))) + +;; Public class methods + +(defun rst-Hdr-preferred-adornments () + ;; testcover: ok. + "Return preferred adornments as list of `rst-Hdr'." + (mapcar (lambda (el) + (rst-Hdr-new-lax + (if (eq (cadr el) 'over-and-under) + (rst-Ado-new-over-and-under (car el)) + (rst-Ado-new-simple (car el))) + (caddr el))) + 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." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) + (and pos (nthcdr pos 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." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (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." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (rst-Ado-is-over-and-under (rst-Hdr-ado self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ttl + +(defstruct + (rst-Ttl + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct with valid parameters for all attributes. + (:constructor + rst-Ttl-new + (ado-arg + match-arg + indent-arg + text-arg + &optional + hdr-arg + level-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 (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) + (level (and level-arg (rst-Ttl--validate-level level-arg))))) + (:copier rst-Ttl-copy)) + "Representation of a reStructuredText section header as found in the buffer. +This type gathers information about an adorned part in the +buffer. Thus only the basic attributes are immutable. Although +the remaining attributes are `setf'-able the respective setters +should be used." + ;; The adornment characteristics or nil for a title candidate. + (ado nil :read-only t) + ;; The match-data for `ado' 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. + (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) + ;; The hierarchical level of the section header starting with 0. + (level nil)) + +;; Private class methods + +(defun rst-Ttl--validate-ado (ado) + ;; testcover: ok. + "Return valid ADO or signal error." + (unless (or (null ado) (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'null 'rst-Ado-p ado))) + ado) + +(defun rst-Ttl--validate-match (match ado) + ;; testcover: ok. + "Return valid MATCH matching ADO or signal error." + (unless (listp match) + (signal 'wrong-type-argument + (list 'listp match))) + (unless (equal (length match) 8) + (signal 'args-out-of-range + '("Match data must consist of exactly 8 buffer positions."))) + (mapcar (lambda (pos) + (unless (or (null pos) (integer-or-marker-p pos)) + (signal 'wrong-type-argument + (list 'integer-or-marker-p 'null pos)))) + match) + (unless (and (integer-or-marker-p (nth 0 match)) + (integer-or-marker-p (nth 1 match))) + (signal 'args-out-of-range + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (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 (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (integer-or-marker-p (nth 6 match)) + (integer-or-marker-p (nth 7 match))) + (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 (nth 2 match)) + (integer-or-marker-p (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) + (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) + (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)) + (unless (null indent) + (signal 'args-out-of-range + '("Indent for a transition must be nil."))) + (unless (integerp indent) + (signal 'wrong-type-argument + (list 'integerp indent))) + (unless (>= indent 0) + (signal 'args-out-of-range + '("Indent for a section header must be non-negative.")))) + indent) + +(defun rst-Ttl--validate-hdr (hdr ado indent) + ;; testcover: ok. + "Return valid HDR in relation to ADO and INDENT or signal error." + (unless (rst-Hdr-p hdr) + (signal 'wrong-type-argument + (list 'rst-Hdr-p hdr))) + (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) + (signal 'args-out-of-range + '("Basic adornment and adornment in header must match."))) + (unless (equal (rst-Hdr-indent hdr) indent) + (signal 'args-out-of-range + '("Basic indent and indent in header must match."))) + hdr) + +(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)) + (unless (null text) + (signal 'args-out-of-range + '("Transitions may not have title text."))) + (unless (stringp text) + (signal 'wrong-type-argument + (list 'stringp text)))) + text) + +(defun rst-Ttl--validate-level (level) + ;; testcover: ok. + "Return valid LEVEL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (unless (>= level 0) + (signal 'args-out-of-range + '("Level must be non-negative."))) + level) + +;; Public methods + +(defun rst-Ttl-evaluate-hdr (self) + ;; testcover: ok. + "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. +Set and return it or nil if no valid `rst-Hdr' can be formed." + (setf (rst-Ttl-hdr self) + (condition-case nil + (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) + (error nil)))) + +(defun rst-Ttl-set-level (self level) + ;; testcover: ok. + "In SELF set and return LEVEL or nil if invalid." + (setf (rst-Ttl-level self) + (rst-Ttl--validate-level level))) + +(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." + (nth 4 (rst-Ttl-match self))) + +(defun rst-Ttl-get-beginning (self) + ;; testcover: ok. + "Return position of beginning of whole SELF." + (nth 0 (rst-Ttl-match self))) + +(defun rst-Ttl-get-end (self) + ;; testcover: ok. + "Return position of end of whole SELF." + (nth 1 (rst-Ttl-match self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Stn + +(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)) + +;; Private class methods + +(defun rst-Stn--validate-ttl (ttl) + ;; testcover: ok. + "Return valid TTL or signal error." + (unless (or (null ttl) (rst-Ttl-p ttl)) + (signal 'wrong-type-argument + (list 'null 'rst-Ttl-p ttl))) + ttl) + +(defun rst-Stn--validate-level (level ttl) + ;; testcover: ok. + "Return valid LEVEL for TTL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (when ttl + (unless (or (not (rst-Ttl-level ttl)) + (equal (rst-Ttl-level ttl) level)) + (signal 'args-out-of-range + '("A title must have correct level or none at all."))) + (when (< 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." + (unless (listp children) + (signal 'wrong-type-argument + (list 'listp children))) + (mapcar (lambda (child) + (unless (rst-Stn-p child) + (signal 'wrong-type-argument + (list 'rst-Stn-p child)))) + children) + (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." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (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." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (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." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (< (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,7 +1199,7 @@ 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 @@ -633,6 +1214,7 @@ as well but give an additional message." def def))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) + ;; Key bindings. (defvar rst-mode-map (let ((map (make-sparse-keymap))) @@ -654,9 +1236,9 @@ as well but give an additional message." (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]) ;; @@ -818,71 +1400,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))) + (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 +1481,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 +1497,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 +1535,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 +1546,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 @@ -1025,156 +1573,111 @@ 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-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)))) + (car + (rst-member-if (lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates)))) (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-update-section (hdr) + "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) + (let ((indent (or (rst-Hdr-indent hdr) 0)) + (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 ? )) + ;; Fixup whitespace at the beginning and end of the line. + (beginning-of-line) + (delete-horizontal-space) + (insert (make-string indent ? )) - (end-of-line) - (delete-horizontal-space) + (end-of-line) + (delete-horizontal-space) - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) + ;; 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. + ;; Remove previous line if it is an adornment. + (save-excursion + (forward-line -1) ;; FIXME testcover: 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-1))))) + (rst-delete-entire-line))) + + ;; Remove following line if it is an adornment. + (save-excursion + (forward-line +1) ;; FIXME testcover: 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 unless it is the final + ;; empty line, for the subsequent inserting of the underline. + (if (and (= (point) (buffer-end 1)) (not (bolp))) + (newline 1))) + + ;; Insert overline. + (when (rst-Hdr-is-over-and-under hdr) (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)) - (open-line 1) - (insert (make-string len char)) - - (1value ;; Line has been inserted above. - (forward-line +1)) - (goto-char marker))) + (beginning-of-line) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))))) + + ;; Insert underline. + (1value ;; Line has been inserted above. + (forward-line +1)) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))) + + (1value ;; Line has been inserted above. + (forward-line +1)) + (goto-char marker))) (defun rst-classify-adornment (adornment end) - "Classify adornment for section titles and transitions. + "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." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) @@ -1189,31 +1692,35 @@ Return nil if no syntactically valid adornment is found." (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. + ;; FIXME testcover: Add test classifying at the end of + ;; buffer. (looking-at (rst-re 'lin-end))))) (prv-emp ; Previous line nonexistent or empty (save-excursion (or (not (zerop (forward-line -1))) (looking-at (rst-re 'lin-end))))) + txt-blw (ttl-blw ; Title found below starting here. (save-excursion (and - (zerop (forward-line 1)) ;; testcover: FIXME: Add test + (zerop (forward-line 1)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. - (looking-at (rst-re 'ttl-beg)) + (looking-at (rst-re 'ttl-beg-1)) + (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)) + (looking-at (rst-re 'ttl-beg-1)) + (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 + (zerop (forward-line 2)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. (looking-at (rst-re ado-re 'lin-end)) @@ -1224,16 +1731,16 @@ Return nil if no syntactically valid adornment is found." (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) + ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq key t + (setq ado (rst-Ado-new-transition) beg-txt beg-pnt end-txt end-pnt)) ((or und-fnd ovr-fnd) ;; An overline with an underline. - (setq key (cons ado-ch 'over-and-under)) + (setq ado (rst-Ado-new-over-and-under ado-ch)) (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)) @@ -1243,41 +1750,40 @@ Return nil if no syntactically valid adornment is found." end-ovr (line-end-position)) (goto-char txt-pnt) (setq beg-txt (point) - end-txt (line-end-position)) + end-txt (line-end-position) + ind (current-indentation) + txt (if ovr-fnd txt-abv txt-blw)) (goto-char und-pnt) (setq beg-und (point) end-und (line-end-position)))) (ttl-abv ;; An underline. - (setq key (cons ado-ch 'simple) + (setq ado (rst-Ado-new-simple ado-ch) beg-und beg-pnt end-und end-pnt) (goto-char ttl-abv) (setq beg-txt (point) - end-txt (line-end-position))) + end-txt (line-end-position) + ind (current-indentation) + txt txt-abv)) (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 () + (setq ado nil))) + (if ado + (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))))))) + +(defun rst-ttl-at-point () "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)) @@ -1285,225 +1791,258 @@ are nil." (orig-end (line-end-position))) (cond ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. (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. + ;; Invalid adornment - check whether this is an overline with + ;; missing underline. (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 'ttl-beg-1))) + (rst-Ttl-new (rst-Ado-new-over-and-under char) + (list orig-pnt (line-end-position) + orig-pnt orig-end + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) + ((rst-Ado-is-transition (rst-Ttl-ado r)) + nil) + ;; Return any other classification as is. + (r)))) ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. (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))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) (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)))))))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (let ((txt (match-string-no-properties 1))) + (or (rst-classify-adornment + (buffer-substring-no-properties + (line-beginning-position 2) (line-end-position 2)) + (line-end-position 2)) + ;; No valid adornment found. + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + 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 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) +(make-variable-buffer-local 'rst-all-ttls-cache) ;; 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 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'.") +(make-variable-buffer-local 'rst-hdr-hierarchy-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 () +(defun rst-all-ttls () "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'. +Return a list of `rst-Ttl' with ascending line number. -Uses and sets `rst-all-sections'." - (unless rst-all-sections +Uses and sets `rst-all-ttls-cache'." + (unless rst-all-ttls-cache (let (positions) ;; Iterate over all the section titles/adornments in the file. (save-excursion - (goto-char (point-min)) - (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) + (save-match-data + (goto-char (point-min)) + (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) + (let ((ttl (rst-classify-adornment + (match-string-no-properties 0) (point)))) + (when (and ttl (rst-Ado-is-section (rst-Ttl-ado ttl))) + (when (rst-Ttl-evaluate-hdr ttl) + (push ttl positions)) + (goto-char (rst-Ttl-get-end ttl))))) + (setq positions (nreverse positions)) + (setq rst-all-ttls-cache (or positions 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)) + (mapcar 'rst-Ttl-copy rst-all-ttls-cache))) + +(defun rst-infer-hdr-hierarchy (hdrs) + "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) + (dolist (hdr hdrs) + (let* ((ado (rst-Hdr-ado hdr)) + (indent (rst-Hdr-indent hdr)) + (found (assoc ado ado2indents))) + (if found + (unless (member indent (cdr found)) + ;; Append newly found indent. + (setcdr found (append (cdr found) (list indent)))) + (push (list ado indent) ado2indents)))) + (mapcar (lambda (ado_indents) + (let ((ado (car ado_indents)) + (indents (cdr ado_indents))) + (rst-Hdr-new + ado + (if (> (length indents) 1) + ;; Indentations used inconsistently - use default. + rst-default-indent + ;; Only one indentation used - use this. + (car indents))))) + (nreverse ado2indents)))) + +(defun rst-hdr-hierarchy (&optional ignore-current) + "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-CURRENT a title found on the +current line 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-CURRENT is +given." + (let* ((all-ttls (rst-all-ttls)) + (ignore-position (if ignore-current + (line-beginning-position))) + (ignore-ttl + (if ignore-position + (car (member-if + (lambda (ttl) + (equal ignore-position (rst-Ttl-get-title-beginning ttl))) + all-ttls)))) + (really-ignore + (if ignore-ttl + (<= (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))) + (mapcar ;; Protect cache. + 'rst-Hdr-copy + (if (and (not ignore-current) 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-current + ;; Clear cache reflecting that a possible update is not + ;; reflected. + nil + (or r t))) + r))))) + +(defun rst-all-ttls-with-level () + "Return the section adornments with levels set according to hierarchy. +Return a list of `rst-Ttl' with ascending line number." + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (mapcar + (lambda (ttl) + (rst-Ttl-set-level ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)) + ttl) + (rst-all-ttls)))) + +(defun rst-get-previous-hdr () + "Return the `rst-Hdr' before point or nil if none." + (let ((ttls (rst-all-ttls)) + (curpos (line-beginning-position)) + prev) ;; 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." + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) curpos)) + (setq prev (car ttls) + ttls (cdr ttls))) + (and prev (rst-Ttl-hdr prev)))) + +(defun rst-adornment-complete-p (ado indent) + "Return true 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 (rst-re "^" (rst-Ado-char ado) + (format "\\{%d\\}" + (+ (save-excursion + ;; Determine last column of title. + (end-of-line) + (current-column)) + indent)) "$"))) + (and + (save-excursion (forward-line +1) + (looking-at exps)) + (or (rst-Ado-is-simple ado) + (save-excursion (forward-line -1) + (looking-at exps)))))) + +(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) "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,12 +2055,9 @@ 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 +See the documentations of `rst-adjust-section' and `rst-promote-region' for full details. -Prefix Arguments -================ - The method can take either (but not both) of a. a (non-negative) prefix argument, which means to toggle the @@ -1542,11 +2078,15 @@ b. a negative numerical argument, which generally inverts the ;; Adjust adornments within region. (rst-promote-region (and pfxarg t)) ;; Adjust adornment around point. - (rst-adjust-adornment-work toggle-style reverse-direction)) + (let ((msg (rst-adjust-section toggle-style reverse-direction))) + (when msg + (apply 'message msg)))) ;; Run the hooks to run after adjusting. (run-hooks 'rst-adjust-hook) + (rst-reset-section-caches) + ;; Make sure to reset the cursor position properly after we're done. (goto-char origpt))) @@ -1567,31 +2107,23 @@ 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))) + (rst-adjust-section toggle-style reverse-direction))) -(defun rst-adjust-adornment-work (toggle-style reverse-direction) +(defun rst-adjust-section (toggle-style reverse) "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: -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; +- adding an adornment if the title does not have one; - adjusting the length of the underline characters to fit a modified title; @@ -1599,316 +2131,242 @@ 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'. - - If REVERSE-DIRECTION is true, we simply use the previous - adornment found directly. +- switching between simple and over-and-under styles by giving + TOGGLE-STYLE. -- if there is no adornment found in the given direction, we use - the first of `rst-preferred-adornments'. +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. -TOGGLE-STYLE forces a toggle of the prescribed adornment style. +The following is a detailed description but you should normally +not have to read it. -Case 2: Incomplete Adornment ----------------------------- +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. -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. +* Case 1: No Adornment -If TOGGLE-STYLE we toggle the style of the adornment as well. + If the current line has no adornment around it, -REVERSE-DIRECTION has no effect in this case. + - 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'. -Case 3: Complete Existing Adornment ------------------------------------ + If REVERSE is true, we simply use the previous adornment found + directly. -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. + - if there is no adornment found in the given direction, we use the first of + `rst-preferred-adornments'. -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. + TOGGLE-STYLE forces a toggle of the prescribed adornment style. -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. +* Case 2: Incomplete Adornment -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 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 TOGGLE-STYLE we toggle the style of the adornment as well. -Point Location -============== + REVERSE has no effect in this case. -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. +* Case 3: Complete Existing Adornment + 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. -Indented Sections -================= + 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 section titles such as :: + If REVERSE is we go up in the hierarchy. Otherwise we go down. - 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 + (let ((ttl (rst-ttl-at-point)) + (orig-pnt (point)) + msg) + (if (not ttl) + (setq msg '("No section header or candidate at point")) + (goto-char (rst-Ttl-get-title-beginning ttl)) + (let ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) + (found (rst-Ttl-ado ttl)) + (indent (rst-Ttl-indent ttl)) + (prev (rst-get-previous-hdr)) + new) + (when (and found (not (rst-Ado-p found))) + ;; Normalize found adornment - overline with no underline counts as + ;; overline. + (setq found (rst-Ado-new-over-and-under found))) + (setq new + (cond + ((not found) + ;; Case 1: No adornment at all. + (let ((hier (rst-hdr-hierarchy))) (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)))))) + ;; 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)) + (t + (setq msg '("Neither hierarchy nor preferences can suggest a deeper header")) + nil)) + ;; 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))) + (t + (setq msg '("No preferences to suggest a top level from")) + nil)))))) + ((not (rst-adornment-complete-p found indent)) + ;; Case 2: Incomplete adornment. + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax found 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 found rst-default-indent)) + (t + ;; Rotate, ignoring a sole adornment around the current line. + (let ((hier (rst-hdr-hierarchy t))) + (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 found indent) hier prev reverse)) + ;; No next header found. + (t + (setq msg '("No preferences or hierarchy to suggest another level from")) + nil)))))) + (if (not new) + (goto-char orig-pnt) + (when toggle-style + (setq new (rst-Hdr-new-invert (rst-Hdr-ado new) 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 new (rst-Hdr-new-lax (rst-Hdr-ado new) indent))) + (rst-update-section 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))))) + msg)) ;; Maintain an alias for compatibility. (defalias 'rst-adjust-section-title 'rst-adjust) - (defun rst-promote-region (demote) "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) + (let ((ttls (rst-all-ttls)) + (hier (rst-hdr-hierarchy)) + (region-beg (save-excursion + (goto-char (region-beginning)) + (line-beginning-position))) + (region-end (save-excursion + (goto-char (region-end)) + (line-beginning-position))) + marker-list) ;; Skip the markers that come before the region beginning. - (while (and cur (< (caar cur) region-begin-line)) - (setq cur (cdr cur))) + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-beg)) + (setq ttls (cdr ttls))) ;; Create a list of markers for all the adornments which are found within ;; the region. (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)) )) + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-end)) + (push (cons (copy-marker (rst-Ttl-get-title-beginning (car ttls))) + (rst-Ttl-hdr (car ttls))) marker-list) + (setq ttls (cdr ttls))) ;; 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)) + ;; `rst-next-hdr' cannot return nil because we apply to a section + ;; header so there is some hierarchy. + (rst-update-section (rst-next-hdr (cdr p) hier nil demote)) ;; Clear marker to avoid slowing down the editing after we're done. (set-marker (car p) nil)) (setq deactivate-mark nil)))) - - -(defun rst-display-adornments-hierarchy (&optional adornments) +(defun rst-display-hdr-hierarchy () "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") + (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 () + "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))))) + (dolist (ttl-marker (mapcar + (lambda (ttl) + (cons ttl (copy-marker + (rst-Ttl-get-title-beginning ttl)))) + (rst-all-ttls-with-level))) + ;; Go to the appropriate position. + (goto-char (cdr ttl-marker)) + (rst-update-section (nth (rst-Ttl-level (car ttl-marker)) + (rst-Hdr-preferred-adornments))) + ;; Reset the marker to avoid slowing down editing. + (set-marker (cdr ttl-marker) nil)))) + +;; 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 @@ -1956,7 +2414,8 @@ If optional ARG is non-nil, insert in current buffer." string (replace-match "" nil t string)) (setq map (cdr map)))) (if arg (insert res) res))) -;================================================= + +;; End of borrow. (defun rst-find-pfx-in-region (beg end pfx-re) "Find all the positions of prefixes in region between BEG and END. @@ -2124,7 +2583,9 @@ If PREFER-ROMAN roman numbering is preferred over using letters." (1+ (string-to-char (match-string 0 curitem)))) nil nil curitem))))) - +;; 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) "Insert a list item at the current point. @@ -2197,112 +2658,57 @@ adjust. If bullets are found on levels beyond the ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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) + +(defun rst-all-stn () + "Return the hierarchical tree of section titles as a top level `rst-Stn'. +Return nil for no section titles." + ;; FIXME: The top level node may contain the document title instead of nil. + (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) + +(defun rst-remaining-stn (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)) +REMAINING is the remaining list of `rst-Ttl' entries. +Return (UNPROCESSED . NODE) for the first entry of REMAINING. +UNPROCESSED is the list of still unprocessed entries. NODE is a +`rst-Stn' or nil if REMAINING is empty." + (let ((ttl (car remaining)) (unprocessed remaining) - ttl-mrk children) + fnd children) ;; If the current adornment matches expected level. - (when (and cur (= (car cur) lev)) + (when (and ttl (= (rst-Ttl-level ttl) lev)) ;; Consume the current entry and create the current node with it. (setq unprocessed (cdr remaining)) - (setq ttl-mrk (cdr cur))) - + (setq fnd ttl)) ;; 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)))) + (while (and unprocessed (> (rst-Ttl-level (car unprocessed)) lev)) + (let* ((rem-child (rst-remaining-stn unprocessed (1+ lev))) + (child (cdr rem-child))) + (when child + (push child children)) + (setq unprocessed (car rem-child)))) (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))))) + (if (or fnd children) + (rst-Stn-new fnd lev children))))) + +(defun rst-stn-containing-point (stn &optional point) + "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 ((children (rst-Stn-children stn)) + found) + (while (and children + (>= point (rst-Stn-get-title-beginning (car children)))) + ;; Point may be in this child. + (setq found (car children) + children (cdr children))) + (if found + (rst-stn-containing-point found point) + stn))))) (defgroup rst-toc nil "Settings for reStructuredText table of contents." @@ -2337,6 +2743,7 @@ indentation style: :group 'rst-toc) (rst-testcover-defcustom) +;; FIXME: What does this mean? ;; This is used to avoid having to change the user's mode. (defvar rst-toc-insert-click-keymap (let ((map (make-sparse-keymap))) @@ -2351,7 +2758,7 @@ indentation style: (rst-testcover-defcustom) (defun rst-toc-insert (&optional pfxarg) - "Insert a simple text rendering of the table of contents. + "Insert a text rendering of the table of contents of the current section. By default the top level is ignored if there is only one, because we assume that the document will have a single title. @@ -2361,98 +2768,77 @@ to the specified level. The TOC is inserted indented at the current column." (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))) - + (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)) + (pt-stn (rst-stn-containing-point (rst-all-stn))) + ;; Figure out initial indent. + (initial-indent (make-string (current-column) ? )) + (init-point (point))) + (when (and pt-stn (rst-Stn-children pt-stn)) + (rst-toc-insert-node pt-stn 0 initial-indent "") + ;; FIXME: Really having the last newline would be better. ;; 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." - +(defun rst-toc-insert-node (stn level indent pfx) + "Insert STN in table-of-contents. +LEVEL is the depth level of the sections in the tree currently +rendered. 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)))))) - + (when (> level 0) + (unless (> (current-column) 0) + ;; No indent yet - insert it. + (insert indent)) + (let ((beg (point))) + (unless (equal rst-toc-insert-style 'plain) + (insert pfx rst-toc-insert-number-separator)) + (insert (rst-Stn-get-text stn)) + ;; 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 beg (point) 'mouse-face 'highlight) + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn))) + (put-text-property beg (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) ? ) " - ")))))) + (when (or (eq rst-toc-insert-max-level nil) + (< level rst-toc-insert-max-level)) + (let ((count 1) + fmt) + ;; 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. + (when (rst-Stn-children stn) + (setq fmt + (format "%%-%dd" + (1+ (floor (log (length (rst-Stn-children stn)) + 10)))))) + (dolist (child (rst-Stn-children stn)) + (rst-toc-insert-node child (1+ level) indent + (concat pfx (format fmt count))) + (incf count))))) (defun rst-toc-update () "Automatically find the contents section of a document and update. @@ -2497,57 +2883,45 @@ file-write hook to always make it up-to-date automatically." ;; 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) )) +;; (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 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." - - (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))) +(defun rst-toc-node (stn buf target) + "Insert STN in the table-of-contents of buffer BUF. +If TARGET is given and this call renders a `rst-Stn' at the same +location return position of beginning of line. Otherwise return +nil." + (let ((beg (point)) + fnd) + (if (or (not stn) (rst-Stn-is-top stn)) + (progn + (insert (format "Table of Contents:\n")) + (put-text-property beg (point) + 'face (list '(background-color . "gray")))) + (when (and target + (equal (rst-Stn-get-title-beginning stn) + (rst-Stn-get-title-beginning target))) + (setq fnd beg)) + (insert (make-string (* rst-toc-indent (rst-Stn-level stn)) ? )) + (insert (rst-Stn-get-text stn)) + ;; Highlight lines. + (put-text-property beg (point) 'mouse-face 'highlight) + (insert "\n") + ;; Add link on lines. + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf))) + (when stn + (dolist (child (rst-Stn-children stn)) + (setq fnd (or (rst-toc-node child buf target) fnd)))) + fnd)) (defvar rst-toc-buffer-name "*Table of Contents*" "Name of the Table of Contents buffer.") @@ -2555,7 +2929,6 @@ children, and t if the node has been found." (defvar rst-toc-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 @@ -2567,37 +2940,21 @@ The Emacs buffer can be navigated, and selecting a section brings the cursor in 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-node (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))))) + (setq target-pos (rst-toc-node sectree target-buf target-node)))) (display-buffer buf) (pop-to-buffer buf) - - ;; 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)))) - + (setq-local rst-toc-return-wincfg wincfg) + (goto-char (or target-pos (point-min))))) (defun rst-toc-mode-find-section () "Get the section from text property at point." @@ -2660,10 +3017,12 @@ EVENT is the input event." (defvar rst-toc-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) + ;; FIXME: This very useful function must be on some key. (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) + ;; FIXME: Killing should clean up like `rst-toc-quit-window' does. (define-key map "z" 'kill-this-buffer) map) "Keymap for `rst-toc-mode'.") @@ -2672,15 +3031,13 @@ EVENT is the input event." ;; 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)) + "Major mode for output from \\[rst-toc], the table-of-contents for the document. -;; Note: use occur-mode (replace.el) as a good example to complete missing -;; features. +\\{rst-toc-mode-map}" + (setq buffer-read-only t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section movement commands -;; ========================= +;; Section movement (defun rst-forward-section (&optional offset) "Skip to the next reStructuredText section title. @@ -2688,38 +3045,32 @@ OFFSET specifies how many titles to skip. Use a negative OFFSET to move backwards in the file (default is to use 1)." (interactive) (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)) + (let* ((offset (or offset 1)) + (ttls (rst-all-ttls)) + (curpos (line-beginning-position)) + (cur ttls) + (idx 0) + ttl) + + ;; Find the index of the "next" adornment with respect to the current line. + (while (and cur (< (rst-Ttl-get-title-beginning (car cur)) curpos)) (setq cur (cdr cur)) (incf idx)) - ;; 'cur' is the adornment on or following the current line. + ;; `cur' is the `rst-Ttl' on or following the current line. - (if (and (> offset 0) cur (= (caar cur) curline)) + (if (and (> offset 0) cur + (equal (rst-Ttl-get-title-beginning (car cur)) curpos)) (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)))))) + (setq ttl (nth idx ttls)) + (goto-char (cond + ((and ttl (>= idx 0)) + (rst-Ttl-get-title-beginning ttl)) + ((> offset 0) + (point-max)) + ((point-min)))))) (defun rst-backward-section () "Like `rst-forward-section', except move back one title." @@ -2751,11 +3102,13 @@ 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) @@ -2768,80 +3121,6 @@ for negative COUNT." (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 - ;; FIXME: At the moment only block comments with leading empty comment line are ;; supported. Comment lines with leading comment markup should be also ;; supported. May be a customizable option could control which style to @@ -3052,7 +3331,7 @@ above. If no suitable tab is found `rst-indent-width' is used." (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. + (leftmostcol leftmostcol)) ;; Create closure. (rst-position-if (lambda (elt) (funcall cmp elt leftmostcol)) tabs))) @@ -3139,7 +3418,7 @@ 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) @@ -3150,7 +3429,8 @@ Region is from BEG to END. ARG is ignored" (indent-rigidly eol end (- rst-indent-comment)) (delete-region bol eol)))) -;;------------------------------------------------------------------------------ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 +3438,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 indented block. A line with less indentation +than IND terminates the current indented block. Such lines and +all following lines not indented to IND are skipped. FUN is +applied to unskipped lines like this + + (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) + +COUNT is 0 before the first indented block and increments for +every indented block found. + +FIRSTP is t when this is the first line of the paragraph. + +SUBP is t when this line is part of a sub-block. + +EMPTYP is t when this line is empty. + +RELIND is nil for an empty line, 0 for a line indented to IND, +and the number of columns more indented otherwise. + +LASTRET is the return value of FUN returned by the last +invocation for the same indented block or nil for the first +invocation. + +When FUN is called point is immediately behind indentation of +that line. FUN may change everything as long as a marker at END +is handled correctly by the change. + +Return the return value of the last invocation of FUN or nil if +FUN was never called." + (let (lastret + subp + skipping + nextm + (count 0) ; Before first indented block + (endm (copy-marker end t))) + (save-excursion + (goto-char beg) + (while (< (point) endm) + (save-excursion + (setq nextm (save-excursion + (forward-line 1) + (copy-marker (point) t))) + (back-to-indentation) + (let (firstp + emptyp + (relind (- (current-column) ind))) + (cond + ((looking-at (rst-re 'lin-end)) + (setq emptyp t) + (setq relind nil) + ;; Breaks indented block if one is started + (setq subp (not (zerop count)))) + ((< relind 0) ; Less indented + (setq skipping t)) + ((zerop relind) ; In indented block + (when (or subp skipping (zerop count)) + (setq firstp t) + (incf count)) + (setq subp nil) + (setq skipping nil)) + (t ; More indented + (setq subp t))) + (unless skipping + (setq lastret + (funcall fun count firstp subp emptyp relind lastret))))) + (goto-char nextm)) + lastret))) + (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)) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert lastret)) + ((or firstp all) + (let ((ins (format "%d. " (incf enum)))) + (setq lastret (make-string (length ins) ?\ )) + (insert ins))) + (t + (insert lastret))) + lastret)))) +;; 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))) + (cont " ")) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert cont)) + ((or firstp all) + (insert bul)) + (t + (insert cont))) + nil)))) ;; FIXME: Does not deal with a varying number of digits appropriately. ;; FIXME: Does not deal with multiple levels independently. @@ -3203,29 +3581,21 @@ Renumber as necessary. Region is from BEG to END." (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." +(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 firstp subp emptyp relind lastret) + (when (or with-empty (not emptyp)) + (move-to-column ind t) + (insert "| ")))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font lock -;; ========= (require 'font-lock) @@ -3525,7 +3895,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 "`") @@ -3714,9 +4084,9 @@ Return extended point or nil if not moved." (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 (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 @@ -3726,7 +4096,7 @@ Return extended point or nil if not moved." ; / 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. + (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 / @@ -3827,7 +4197,7 @@ next non-empty line if this is indented more than the current one." "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 +4216,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 +4240,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 +4257,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 +4295,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 @@ -4002,16 +4371,17 @@ select the alternative tool-set." (outname (file-name-sans-extension bufname))) ;; 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 outname extension))) + " ")) ;; Invoke the compile command. (if (or compilation-read-command use-alt) @@ -4036,7 +4406,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 +4423,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 +4441,41 @@ buffer, if the region is not selected." ;; output. )) +;; FIXME: Add `rst-compile-html-preview'. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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 +4483,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) @@ -4228,12 +4572,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 98a01e8d83f..f476cfbba04 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)) @@ -842,6 +845,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 +884,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 +1089,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 +1258,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 +1304,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 +1338,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 +1563,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 +1782,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 +1800,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 +1834,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 +1870,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 +1889,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 +1925,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 +1947,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 +2002,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 +2065,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 +2091,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 +2183,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 +2282,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 653db83107d..e12a34095bb 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 ea7fbf8d4c2..25d674541c5 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 c22f531440d..bc82bb6d0a4 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 731c2d2d85d..30873e1dfdb 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 598060e9ec8..cd258b8c970 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]\\)" |