nxhtml/nxhtml/nxhtml.el

   1 ;;; nxhtml.el --- Keeping nXhtml together
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2009-01-01 Thu
   5 ;; Version:
   6 ;; Last-Updated:
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;;
  20 ;;
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;;
  23 ;;; Change log:
  24 ;;
  25 ;;
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;; This program is free software; you can redistribute it and/or
  29 ;; modify it under the terms of the GNU General Public License as
  30 ;; published by the Free Software Foundation; either version 2, or
  31 ;; (at your option) any later version.
  32 ;;
  33 ;; This program is distributed in the hope that it will be useful,
  34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  36 ;; General Public License for more details.
  37 ;;
  38 ;; You should have received a copy of the GNU General Public License
  39 ;; along with this program; see the file COPYING.  If not, write to
  40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  41 ;; Floor, Boston, MA 02110-1301, USA.
  42 ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;
  45 ;;; Code:
  46
  47 (eval-when-compile (require 'cl))
  48 (eval-when-compile (require 'loadhist))
  49 (eval-when-compile (require 'nxhtml-base))
  50 (eval-and-compile (require 'nxhtml-menu nil t))
  51
  52 ;;;###autoload
  53 (defgroup nxhtml nil
  54   "Customization of `nxhtml-mode'."
  55   :group 'nxml)
  56
  57 ;;;###autoload
  58 (defun nxhtml-customize ()
  59   "Customize nXhtml."
  60   (interactive)
  61   (customize-group 'nxhtml))
  62
  63
  64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65 ;; Features
  66
  67 ;; Fix-me: add help links
  68 (defvar nxhtml-req-features
  69   (let ((req-features
  70          '(
  71            "XHTML/HTML"
  72            (nxml-mode    "XML Completion" "nxml-mode.el")
  73            (nxhtml       "Additional XHTML Completion" "nxhtml.el")
  74            (mlinks       "Live XHTML links" "mlinks.el" "0.28")
  75            (tidy-xhtml   "Run HTML tidy program" "tidy-xhtml.el" "2.24")
  76            (xhtml-help   "HTML+CSS help" "xhtml-help.el" "0.57")
  77            (nxml-where   "Shows XML path" "nxml-where.el" "0.52")
  78            (html-imenu   "Table of content in menus" "html-imenu.el" "0.9")
  79            (html-pagetoc "Page TOC" "html-pagetoc.el" "0.85")
  80            (html-site    "Web sites you define" "html-site.el" "0.2")
  81            (html-upl     "Upload web sites" "html-upl.el" "0.2")
  82            (html-chklnk  "Checking links in site" "html-chklnk.el" "0.2")
  83            (html-move    "Moving files in web sites" "html-move.el" "0.31")
  84            (html-toc     "Web site TOC" "html-toc.el" "0.4")
  85            (html-wtoc    "Merge pages and web Site TOC" "html-wtoc.el" "0.2")
  86            (html-write   "Show <i> as italic etc" "html-write.el" "0.6")
  87            "General"
  88            (mumamo       "Multiple major modes in buffer" "mumamo.el" "0.73")
  89            (majmodpri    "Major mode priorities" "majmodpri.el" "0.5")
  90            (tabkey2      "Tab completion" "tabkey2.el" "1.12")
  91            (fold-dwim    "Folding on headers and tags" "fold-dwim.el" "1.3")
  92            (appmenu      "General popup menu" "appmenu.el" "0.53")
  93            (appmenu-fold "Popup menu entries for folding" "appmenu-fold.el" "0.51" appmenu fold-dwim)
  94            (winsize      "Resizing and window handling" "winsize.el" "0.98")
  95            (winsav       "Save/restore for windows/frames" "winsav.el" "0.77")
  96            (viper-tut    "Viper try-out tutorial" "viper-tut.el" "0.2")
  97            (ourcomments-util "Some minor utilities" "ourcomments-util.el" "0.25")
  98            "External applications / Emacs as dito"
  99            (as-external  "Emacs as an external editor" "as-external.el" "0.5")
 100            (sex-mode     "Send to EXternal program" "sex-mode.el" "0.71")
 101            (freemind     "Export/import freemind maps" "freemind.el" "0.60")
 102            (hfyview      "Print with browser/copy to html" "hfyview.el" "0.63")
 103            (mozadd       "Mirroring in Firefox" "mozadd.el" "0.2")
 104            "Images and Colors"
 105            (gimpedit     "Edit images with GIMP" "gimp.el" "0.3")
 106            (inlimg       "Inline images" "inlimg.el" "0.7")
 107            (css-color    "Css color help functions" "css-color.el" "0.02")
 108            (chart        "Easy google charts" "chart.el" "0.2")
 109            "Fetching and using elisp from repositories"
 110            (udev         "Fetch and from elisp repostories" "udev.el" "0.5")
 111            ;;(udev-cedet   "CEDET fetcher and loader" "udev-cedet.el" "0.2")
 112            (udev-ecb     "ECB fetcher and loader" "udev-ecb.el" "0.2")
 113            (udev-rinari  "Rinari fetcher and loader" "udev-rinari.el" "0.2")
 114            "Games and life"
 115            (pause        "Take a break! I wish you some fun!" "pause.el" "0.64")
 116            (n-back       "n-back game for fun and brain" "n-back.el" "0.5")
 117            )
 118          ))
 119     req-features))
 120
 121 (defun nxhtml-load-req-features ()
 122   (dolist (extf nxhtml-req-features)
 123     (unless (or (stringp extf)
 124                 (eq (car extf) 'nxhtml))
 125       (require (car extf) nil t))))
 126
 127
 128
 129 (defun nxhtml-make-library-link (beg end)
 130   (let ((library (buffer-substring-no-properties beg end)))
 131     (make-text-button beg end
 132                       'action (lambda (button)
 133                                 (find-library
 134                                  (button-get button 'lib-name)))
 135                       'lib-name library
 136                       'face 'button)))
 137
 138 (defun nxhtml-feature-insert (ok msg)
 139   (put-text-property 0 (length msg)
 140                      'face (if ok font-lock-type-face font-lock-warning-face)
 141                      msg)
 142   (insert msg))
 143
 144 (defun nxhtml-feature-check (feat-entry silent)
 145   (require 'loadhist)
 146   (let ((feature     (nth 0 feat-entry))
 147         (description (nth 1 feat-entry))
 148         (file        (nth 2 feat-entry))
 149         (need-ver    (nth 3 feat-entry))
 150         (need-list   (cddddr feat-entry))
 151         (ok))
 152     (if (featurep feature)
 153         (let* (
 154                (feat-versym (read (format "%s:version" feature)))
 155                (feat-ver (condition-case err
 156                              (symbol-value feat-versym)
 157                            (error nil)))
 158                (feat-vok (or (not need-ver)
 159                              (and feat-ver
 160                                   (version<= need-ver feat-ver))))
 161                (need-ok (or (not need-list)
 162                             (let ((has t))
 163                               (dolist (n need-list)
 164                                 (unless (featurep n)
 165                                   (setq has nil)))
 166                               has))))
 167           (setq ok (and feat-vok need-ok))
 168           (unless silent
 169             (nxhtml-feature-insert
 170              ok
 171              (concat (format "%34s -- " description)
 172                      (if ok
 173                          (format "supported by %s%s\n"
 174                                  file
 175                                  (if (not need-ver)
 176                                      ""
 177                                    (if (string= feat-ver need-ver)
 178                                        (format " (%s)" feat-ver)
 179                                      (format " (%s/%s)" feat-ver need-ver))))
 180                        (concat "found " file
 181                                " but needs"
 182                                (if feat-vok ""
 183                                  (format " version %s" need-ver))
 184                                (if (or feat-vok need-ok) "" " and")
 185                                (if need-ok ""
 186                                  (format " also %s" need-list))
 187                                "\n"))))
 188             (unless (string= (file-name-sans-extension file)
 189                              (file-name-sans-extension
 190                               (file-name-nondirectory (feature-file feature))))
 191               (insert (make-string (+ 34 4) ?\ ) "** Bad file name: " file "\n"))))
 192       (unless silent
 193         (nxhtml-feature-insert
 194          nil (format "%34s -- support missing, can't find %s\n"
 195                      description file))))
 196     ok))
 197
 198 ;; Fix-me: move help here from `nxhtml-mode'?
 199
 200 ;;;###autoload
 201 (defun nxhtml-features-check ()
 202   "Check if external modules used by nXhtml are found."
 203   (interactive)
 204   (with-output-to-temp-buffer (help-buffer)
 205     (help-setup-xref (list #'nxhtml-features-check) (interactive-p))
 206     (with-current-buffer (help-buffer)
 207       (nxhtml-menu-mode 1)
 208       (erase-buffer)
 209       (let ((s (concat "Elisp modules used by nXhtml version " nxhtml-menu:version ":")))
 210         (put-text-property 0 (length s)
 211                            'face '( :weight bold :height 1.4)
 212                            s)
 213         (insert s "\n\n"))
 214       (nxhtml-load-req-features)
 215       (nxhtml-load-req-features)
 216       (nxhtml-load-req-features)
 217       (nxhtml-load-req-features)
 218       (dolist (feat-entry nxhtml-req-features)
 219         (if (stringp feat-entry)
 220             (insert "==== " (propertize feat-entry 'face 'font-lock-comment-face 'face '(:weight bold)) "\n")
 221           (nxhtml-feature-check feat-entry nil)))
 222       (goto-char (point-min))
 223       (while (search-forward-regexp "[-a-zA-Z0-9]+\\.el" nil t)
 224         (nxhtml-make-library-link
 225          (match-beginning 0)
 226          (match-end 0)))
 227       (goto-char (point-min)))
 228     (set-buffer-modified-p nil)))
 229
 230 (defun nxhtml-all-features-found ()
 231   (let ((all t))
 232     (dolist (feat-entry nxhtml-req-features)
 233       ;;(unless (featurep (car extf))
 234       (unless (stringp feat-entry)
 235         (unless (nxhtml-feature-check feat-entry t)
 236           (setq all nil))))
 237     all))
 238
 239
 240 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 241 ;; Link saving and pasting
 242
 243 (defun nxhtml-find-base-href ()
 244   "Return base href found in the current file."
 245   (let ((base-href))
 246     (save-excursion
 247       (goto-char (point-min))
 248       (while (and (not base-href)
 249                   (search-forward-regexp "<!--[^!]*-->\\|<base[[:space:]]" nil t))
 250         (when (equal " " (char-to-string (char-before)))
 251           (backward-char 6)
 252           (when (looking-at "<base [^>]*href *= *\"\\(.*?\\)\"")
 253             (setq base-href (match-string-no-properties 1))))))
 254     base-href))
 255
 256
 257 (defvar nxhtml-saved-link-file nil
 258   "Saved buffer file name for use in `nxhtml-paste-link'.")
 259 (defvar nxhtml-saved-link-anchor nil
 260   "Saved anchor name for use in `nxhtml-paste-link'.")
 261
 262 ;; Fix-me: same line???
 263 (defun nxhtml-save-link-to-here ()
 264   "Save buffer file name+anchor for `nxhtml-paste-link'."
 265   (interactive)
 266   (if (not buffer-file-name)
 267       (message "Current buffer has no file name")
 268     (setq nxhtml-saved-link-file (buffer-file-name))
 269     (setq nxhtml-saved-link-anchor nil)
 270     (save-excursion
 271       (let ((here (point)))
 272         (while (not (or (bolp) (looking-at "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\".*?\"")))
 273           (backward-char))
 274         (when (and (looking-at "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\"\\(.*?\\)\"")
 275                    (<= (match-beginning 0) here)
 276                    (< here (match-end 0)))
 277           (setq nxhtml-saved-link-anchor (match-string-no-properties 1)))))
 278     (message "Saved link: %s%s" nxhtml-saved-link-file
 279              (if nxhtml-saved-link-anchor
 280                  (concat "#" nxhtml-saved-link-anchor)
 281                ""))))
 282
 283 (defun nxhtml-paste-link-as-a-tag ()
 284   "Paste link saved by `nxhtml-save-link-to-here' as an <a> tag.
 285 Takes into account the relative position of the saved link."
 286   (interactive)
 287   (let ((paste-text (nxhtml-get-saved-link)))
 288     (when paste-text
 289       (let ((link-text (read-string "Link text: ")))
 290         (insert "<a href=\"" paste-text "\">" link-text "</a>")))))
 291
 292 (defun nxhtml-paste-link ()
 293   "Paste link saved by `nxhtml-save-link-to-here'.
 294 Takes into account the relative position of the saved link."
 295   (interactive)
 296   (let ((paste-text (nxhtml-get-saved-link)))
 297     (when paste-text
 298       (insert paste-text))))
 299
 300 (defun nxhtml-get-saved-link ()
 301   (if nxhtml-saved-link-file
 302       (let* (
 303              (base-href (nxhtml-find-base-href))
 304              (rel (file-relative-name nxhtml-saved-link-file
 305                                       (if base-href
 306                                           base-href
 307                                         (file-name-directory (buffer-file-name)))))
 308              (to-file (file-name-nondirectory (buffer-file-name)))
 309              (anchor nxhtml-saved-link-anchor)
 310              )
 311         (when (equal to-file rel) (setq rel ""))
 312         (when anchor (setq rel (concat rel "#" anchor)))
 313         rel)
 314     (message "There is no saved link")
 315     nil))
 316
 317
 318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319 ;; Misc
 320
 321 (defun nxhtml-update-mark-today (date-str)
 322   "Update marks for today's date.
 323 The mark has this form
 324
 325   <!-- today -->zzz<!-- end today -->"
 326   (interactive (list (format-time-string "%Y-%m-%d")))
 327   (save-excursion
 328     (goto-char (point-min))
 329     (while (re-search-forward (rx
 330                                "<!-- today -->"
 331                                (submatch (0+ anything))
 332                                "<!-- end today -->")
 333                               nil t)
 334       (replace-match date-str nil nil nil 1))))
 335
 336
 337 (provide 'nxhtml)
 338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 339 ;;; nxhtml.el ends here