diff options
Diffstat (limited to 'emacs.d/nxhtml/util/mlinks.el')
| -rw-r--r-- | emacs.d/nxhtml/util/mlinks.el | 1367 |
1 files changed, 1367 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/mlinks.el b/emacs.d/nxhtml/util/mlinks.el new file mode 100644 index 0000000..0f81654 --- /dev/null +++ b/emacs.d/nxhtml/util/mlinks.el @@ -0,0 +1,1367 @@ +;;; mlinks.el --- Minor mode making major mode dependent links +;; +;; Author: Lennar Borgman +;; Created: Tue Jan 16 2007 +(defconst mlinks:version "0.28") ;;Version: +;; Last-Updated: 2010-01-05 Tue +;; Keywords: +;; Compatibility: +;; +;; Fxeatures that might be required by this library: +;; +;; `appmenu', `cl', `mail-prsvr', `mm-util', `ourcomments-util', +;; `url-expand', `url-methods', `url-parse', `url-util', +;; `url-vars'. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This file implements the minor mode `mlinks-mode' that create +;; hyperlinks for different major modes. Such links can be visible or +;; invisible. The meanings of the links are defined per mode. +;; +;; Examples: +;; +;; - In in html style modes the links are visible they can mean either +;; open a file for editing, go to an achnor or view the link in a +;; web browser etc. +;; +;; - In emacs lisp mode the links are invisible, but maybe highlighed +;; when point or mouse is on them. (Having them highlighted when +;; point is on them can be a quick way to check that you have +;; spelled a symbol correct.) The meanings of the links in emacs +;; lisp mode are go to definition. +;; +;; Common to links that open a buffer in Emacs is that you can the +;; buffer opened in the same window, the other window or in a new +;; frame. The same key binding is used in all major modes for this. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change log: +;; +;; FIX-ME: url-hexify-string etc +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'appmenu nil t)) +(eval-when-compile (require 'mumamo nil t)) +(eval-when-compile (require 'ourcomments-util nil t)) + +(require 'rx) +(require 'url-parse) +(require 'url-expand) + +(defvar mlinks-point-hilighter-overlay nil) +(make-variable-buffer-local 'mlinks-point-hilighter-overlay) +(put 'mlinks-point-hilighter-overlay 'permanent-local t) + +;;;###autoload +(defgroup mlinks nil + "Customization group for `mlinks-mode'." + :group 'nxhtml + :group 'hypermedia) + +(defvar mlinks-link-face 'mlinks-link-face) +(defface mlinks-link-face + '((t (:inherit highlight))) + "Face normally active links have on them." + :group 'mlinks) + +(defvar mlinks-hyperactive-link-face 'mlinks-hyperactive-link-face) +(defface mlinks-hyperactive-link-face + '((t (:inherit isearch))) + "Face hyper active links have on them." + :group 'mlinks) + +(defvar mlinks-font-lock-face 'mlinks-font-lock-face) +(defface mlinks-font-lock-face + '((t :inherit link)) + "Default face for MLinks' links." + :group 'mlinks) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode function bindings + +;;(customize-option mlinks-mode-functions) +(defcustom mlinks-mode-functions + '( + ;; For message buffer etc. + (fundamental-mode + ((goto mlinks-elisp-goto) + (hili mlinks-elisp-hili) + (hion t) + ) + ) + (emacs-lisp-mode + ((goto mlinks-elisp-goto) + (hili mlinks-elisp-hili) + (hion t) + ) + ) + ;; *scractch* + (lisp-interaction-mode + ((goto mlinks-elisp-goto) + (hili mlinks-elisp-hili) + (hion t) + ) + ) + (help-mode + ((goto mlinks-elisp-goto) + (hili mlinks-elisp-hili) + (hion t) + ) + ) + (Info-mode + ((goto mlinks-elisp-goto) + (hili mlinks-elisp-hili) + (hion t) + ) + ) + (Custom-mode + ((goto mlinks-elisp-custom-goto) + (hili mlinks-elisp-hili) + (hion t) + (fontify mlinks-custom-fontify) + ) + ) + (text-mode + ((goto mlinks-goto-plain-url) + (hion t) + (fontify mlinks-plain-urls-fontify) + ) + ) + (nxhtml-mode + ((hion t) + (fontify mlinks-html-fontify) + (goto mlinks-html-style-goto) + ) + ) + (nxml-mode + ((hion t) + (fontify mlinks-html-fontify) + (goto mlinks-html-style-goto) + ) + ) + (sgml-mode + ((hion t) + (fontify mlinks-html-fontify) + (goto mlinks-html-style-goto) + ) + ) + (html-mode + ((hion t) + (fontify mlinks-html-fontify) + (goto mlinks-html-style-goto) + ) + ) + ) + "Defines MLinks hyperlinks for major modes. +" + ;; Each element in the list is a list with two elements + + ;; \(MAJOR-MODE SETTINGS) + + ;; where MAJOR-MODE is the major mode for which the settings SETTINGS should be used. + ;; SETTINGS is an association list which can have the following element types + + ;; \(hili HILIGHT-FUN) ;; Mandatory + ;; \(goto GOTO-FUN) ;; Mandatory + ;; \(hion HION-BOOL) ;; Optional + ;; \(next NEXT-FUN) ;; Optional + ;; \(prev PREV-FUN) ;; Optional + + ;; Where + ;; - HILIGHT-FUN is the function to hilight a link when point is + ;; inside the link. This is done when Emacs is idle. + ;; - GOTO-FUN is the function to follow the link at point. + ;; - HION-BOOL is t or nil depending on if hilighting should be on + ;; by default. + ;; - NEXT-FUN is the function to go to the next link. + ;; - PREV-FUN is the function to go to the previous link." + ;; ;;:type '(repeat (alist :key-type symbol :value-type (alist :key-type symbol :value symbol))) + :type '(alist :key-type major-mode-function + :value-type (list + (set + (const :tag "Enable MLinks in this major mode" hion) + (const :tag "Mark All Links" mark) + (list :tag "Enable" (const :tag "Hilighting" hili) function) + (list :tag "Enable" (const :tag "Follow Link" goto) function) + (list :tag "Enable" (const :tag "Goto Next Link" next) function) + (list :tag "Enable" (const :tag "Goto Previous Link" prev) function) + ))) + :group 'mlinks) + + +(defun mlinks-get-mode-value (which) + (let* ((major major-mode) + (mode-rec (assoc major mlinks-mode-functions))) + (catch 'mode-rec + (while (and major + (not mode-rec)) + (setq major (get major 'derived-mode-parent)) + (setq mode-rec (assoc major mlinks-mode-functions)) + (when mode-rec (throw 'mode-rec nil)))) + (when mode-rec + (let* ((mode (car mode-rec)) + (funs-alist (cadr mode-rec)) + (funs (assoc which funs-alist))) + (cdr funs))))) + + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Minor modes + +;; (appmenu-dump-keymap mlinks-mode-map) +(defvar mlinks-mode-map + (let ((m (make-sparse-keymap "mlinks"))) + (define-key m [(control ?c) ?\r ?\r] 'mlinks-goto) + (define-key m [(control ?c) ?\r ?w] 'mlinks-goto-other-window) + (define-key m [(control ?c) ?\r ?f] 'mlinks-goto-other-frame) + (define-key m [(control ?c) ?\r ?n] 'mlinks-next-saved-position) + (define-key m [(control ?c) ?\r ?p] 'mlinks-prev-saved-position) + (define-key m [(control ?c) ?\r S-tab] 'mlinks-backward-link) + (define-key m [(control ?c) ?\r tab] 'mlinks-forward-link) + (define-key m [(control ?c) ?\r ?h] 'mlinks-toggle-hilight) + (define-key m [(control ?c) ?\r ?c] 'mlinks-copy-link-text) + m)) + +;;;###autoload +(define-minor-mode mlinks-mode + "Recognizes certain parts of a buffer as hyperlinks. +The hyperlinks are created in different ways for different major +modes with the help of the functions in the list +`mlinks-mode-functions'. + +The hyperlinks can be hilighted when point is over them. Use +`mlinks-toggle-hilight' to toggle this feature for the current +buffer. + +All keybindings in this mode are by default done under the prefi§x +key + + C-c RET + +which is supposed to be a kind of mnemonic for link (alluding to +the RET key commonly used in web browser to follow a link). +\(Unfortunately this breaks the rules in info node `Key Binding +Conventions'.) Below are the key bindings defined by this mode: + +\\{mlinks-mode-map} + +For some major modes `mlinks-backward-link' and +`mlinks-forward-link' will take you to the previous/next link. +By default the link moved to will be active, see +`mlinks-active-links'. + +" + nil + " L" + nil + :keymap mlinks-mode-map + :group 'mlinks + (if mlinks-mode + (progn + (mlinks-add-appmenu) + (mlinks-start-point-hilighter) + (mlinks-add-font-lock)) + (mlinks-stop-point-hilighter) + (when mlinks-point-hilighter-overlay + (when (overlayp mlinks-point-hilighter-overlay) + (delete-overlay mlinks-point-hilighter-overlay)) + (setq mlinks-point-hilighter-overlay nil)) + (mlinks-remove-font-lock))) +(put 'mlinks-mode 'permanent-local t) + +(defun mlinks-turn-on-in-buffer () + (let ((hion (unless (and (boundp 'mumamo-set-major-running) + mumamo-set-major-running) + (mlinks-get-mode-value 'hion)))) + (when hion (mlinks-mode 1)))) + +;;;###autoload +(define-globalized-minor-mode mlinks-global-mode mlinks-mode + mlinks-turn-on-in-buffer + "Turn on `mlink-mode' in all buffer where it is specified. +This is specified in `mlinks-mode-functions'." + :group 'mlinks) + +;; The problem with global minor modes: +(when (and mlinks-global-mode + (not (boundp 'define-global-minor-mode-bug))) + (mlinks-global-mode 1)) + +;;(define-toggle mlinks-active-links t +(define-minor-mode mlinks-active-links + "Use quick movement keys on active links if non-nil. +When moving to an mlink with `mlinks-forward-link' or +`mlinks-backward-link' the link moved to will be in an active +state. This is marked with a new color \(the face `isearch'). +When the new color is shown the following keys are active + +\\{mlinks-hyperactive-point-hilighter-keymap} +Any command cancels this state." + :global t + :init-value t + :group 'mlinks) + + + +(defun mlinks-link-text-prop-range (pos) + (let* ((link-here (get-text-property pos 'mlinks-link)) + (beg (when link-here (previous-single-char-property-change (+ pos 1) 'mlinks-link))) + (end (when link-here (next-single-char-property-change (- pos 0) 'mlinks-link)))) + (when (and beg end) + (cons beg end)))) + +(defun mlinks-link-range (pos) + (or (mlinks-link-text-prop-range pos) + (let ((funs-- (mlinks-get-mode-value 'hili))) + (when funs-- + (save-match-data + (run-hook-with-args-until-success 'funs--)))))) + +(defun mlinks-link-at-point () + "Get link at point." + (mlinks-point-hilighter-1) + (when (and mlinks-point-hilighter-overlay + (overlay-buffer mlinks-point-hilighter-overlay)) + (let* ((ovl mlinks-point-hilighter-overlay) + (beg (overlay-start ovl)) + (end (overlay-end ovl))) + (buffer-substring-no-properties beg end)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; At point highligher + +(defvar mlinks-point-hilighter-timer nil) + +(defun mlinks-stop-point-hilighter () + (when (timerp mlinks-point-hilighter-timer) + (cancel-timer mlinks-point-hilighter-timer) + (setq mlinks-point-hilighter-timer nil))) + +(defun mlinks-start-point-hilighter () + (mlinks-stop-point-hilighter) + (setq mlinks-point-hilighter-timer + (run-with-idle-timer 0.1 t 'mlinks-point-hilighter))) + +(defvar mlinks-link-overlay-priority 100) + +(defun mlinks-make-point-hilighter-overlay (bounds) + (unless mlinks-point-hilighter-overlay + (setq mlinks-point-hilighter-overlay + (make-overlay (car bounds) (cdr bounds))) + (overlay-put mlinks-point-hilighter-overlay 'priority mlinks-link-overlay-priority) + (overlay-put mlinks-point-hilighter-overlay 'mouse-face 'highlight) + (mlinks-set-normal-point-hilight) + )) + +(defun mlinks-point-hilighter () + "Mark link at point if any. +This moves the hilight point overlay to point or deletes it." + ;; This runs in a timer, protect it. + (condition-case err + (let ((inhibit-point-motion-hooks t)) + (mlinks-point-hilighter-1)) + (error "mlinks-point-hilighter error: %s" (error-message-string err)))) + +(defun mlinks-point-hilighter-1 () + (when mlinks-mode + (let ((bounds-- (mlinks-link-range (point)))) + (if bounds-- + (if mlinks-point-hilighter-overlay + (move-overlay mlinks-point-hilighter-overlay (car bounds--) (cdr bounds--)) + (mlinks-make-point-hilighter-overlay bounds--)) + (when mlinks-point-hilighter-overlay + (delete-overlay mlinks-point-hilighter-overlay)))))) + +(defvar mlinks-hyperactive-point-hilighter-keymap + (let ((m (make-sparse-keymap "mlinks"))) + (define-key m [S-tab] 'mlinks-backward-link) + (define-key m [tab] 'mlinks-forward-link) + (define-key m "\t" 'mlinks-forward-link) + (define-key m [?\r] 'mlinks-goto) + (define-key m [?w] 'mlinks-goto-other-window) + (define-key m [?f] 'mlinks-goto-other-frame) + (define-key m [mouse-1] 'mlinks-goto) + (set-keymap-parent m mlinks-mode-map) + m)) + +(defvar mlinks-point-hilighter-keymap + (let ((m (make-sparse-keymap "mlinks"))) + (define-key m [mouse-1] 'mlinks-goto) + (set-keymap-parent m mlinks-mode-map) + m)) + +(defun mlinks-point-hilighter-pre-command () + (condition-case err + (unless (let ((map (overlay-get mlinks-point-hilighter-overlay 'keymap))) + (where-is-internal this-command + (list + map))) + (mlinks-set-normal-point-hilight) + (unless mlinks-point-hilighter-timer + (delete-overlay mlinks-point-hilighter-overlay))) + (error (message "mlinks-point-hilighter-pre-command: %s" err)))) +(put 'mlinks-point-hilighter-pre-command 'permanent-local t) + +(defun mlinks-set-hyperactive-point-hilight () + "Make link hyper active, ie add some special key binding. +Used after jumping specifically to a link. The idea is that the +user may want to easily jump between links in this state." + (add-hook 'pre-command-hook 'mlinks-point-hilighter-pre-command nil t) + (mlinks-point-hilighter) + (overlay-put mlinks-point-hilighter-overlay 'face mlinks-hyperactive-link-face) + (overlay-put mlinks-point-hilighter-overlay 'keymap mlinks-hyperactive-point-hilighter-keymap)) + +(defun mlinks-set-normal-point-hilight () + "Make link normally active as if you happened to be on it." + (remove-hook 'pre-command-hook 'mlinks-point-hilighter-pre-command t) + (mlinks-point-hilighter) + (overlay-put mlinks-point-hilighter-overlay 'face mlinks-link-face) + (overlay-put mlinks-point-hilighter-overlay 'keymap mlinks-point-hilighter-keymap)) + +(defun mlinks-set-point-hilight-after-jump-to () + "Set hilight style after jump to link." + (if mlinks-active-links + (mlinks-set-hyperactive-point-hilight) + (mlinks-set-normal-point-hilight))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Jumping around + +(defvar mlinks-places nil) +(make-variable-buffer-local 'mlinks-placesn) +(put 'mlinks-places 'permanent-local t) + +(defvar mlinks-places-n 0) +(make-variable-buffer-local 'mlinks-places-n) +(put 'mlinks-places-n 'permanent-local t) + +(defun mlinks-has-links () + (or (mlinks-get-mode-value 'fontify) + (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode) + ;; Fix-me: just assume multi major has it... Need a list of + ;; major modes. There is no way to get such a list for the + ;; multi major mode (since you can't know what the chunk + ;; functions will return. However you can get a list of + ;; current chunks major mode. + t + ))) + +(defun mlinks-backward-link () + "Go to previous `mlinks-mode' link in buffer." + (interactive) + (if (not (mlinks-has-links)) + (message "There is no way to go to previous link for this major mode") + (let ((res (mlinks-prev-link))) + (if res + (progn + (goto-char res) + (mlinks-set-point-hilight-after-jump-to)) + (message "No previous link found"))))) + +(defun mlinks-forward-link () + "Go to next `mlinks-mode' link in buffer." + (interactive) + (if (not (mlinks-has-links)) + (message "There is no way to go to next link for this major mode") + (let ((res (mlinks-next-link))) + (if res + (progn + (goto-char res) + (mlinks-set-point-hilight-after-jump-to)) + (message "No next link found"))))) + + +(defun mlinks-goto () + "Follow `mlinks-mode' link at current point. +Save the current position so that they can be move to again by +`mlinks-prev-saved-position' and `mlinks-next-saved-position'. + +Return non-nil if link was followed, otherewise nil." + (interactive) + (mlinks-goto-1 nil)) + +(defun mlinks-goto-other-window () + "Like `mlinks-goto' but opens in other window. +Uses `switch-to-buffer-other-window'." + (interactive) + (mlinks-goto-1 'other-window)) + +(defun mlinks-goto-other-frame () + "Like `mlinks-goto' but opens in other frame. +Uses `switch-to-buffer-other-frame'." + (interactive) + (mlinks-goto-1 'other-frame)) + +(defun mlinks-goto-1(where) + (push-mark) + (let* ((funs (mlinks-get-mode-value 'goto)) + (old (point-marker)) + (mlinks-temp-buffer-where where) + (res (run-hook-with-args-until-success 'funs))) + (if (not res) + (progn + (message "Don't know how to follow this MLink link") + nil) + (unless (= old (point-marker)) + (let* ((prev (car mlinks-places))) + (when (or (not prev) + ;;(not (markerp prev)) + (not (marker-buffer prev)) + (/= old prev)) + (setq mlinks-places (cons old mlinks-places)) + (setq mlinks-places-n (length mlinks-places)))))))) + + +(defun mlinks-prev-saved-position () + "Go to previous position saved by `mlinks-goto'." + (interactive) + (unless (mlinks-goto-n (1- mlinks-places-n)) + (message "No previous MLink position"))) + +(defun mlinks-next-saved-position () + "Go to next position saved by `mlinks-goto'." + (interactive) + (unless (mlinks-goto-n (1+ mlinks-places-n)) + (message "No next MLink position"))) + +(defun mlinks-goto-n (to) + (if (not mlinks-places) + (message "No saved MLinks positions") + (let ((minp 1) + (maxp (length mlinks-places))) + (if (<= to minp) + (progn + (setq to minp) + (message "Going to first MLinks position")) + (if (>= to maxp) + (progn + (setq to maxp) + (message "Going to last MLinks position")))) + (setq mlinks-places-n to) + (let ((n (- maxp to)) + (places mlinks-places) + place + buffer + point) + (while (> n 0) + (setq places (cdr places)) + (setq n (1- n))) + (setq place (car places)) + (mlinks-switch-to-buffer (marker-buffer place)) + (goto-char place))))) + +(defvar mlinks-temp-buffer-where nil) +(defun mlinks-switch-to-buffer (buffer) + (mlinks-switch-to-buffer-1 buffer mlinks-temp-buffer-where)) + +(defun mlinks-switch-to-buffer-1(buffer where) + (cond + ((null where) + (switch-to-buffer buffer)) + ((eq where 'other-window) + (switch-to-buffer-other-window buffer)) + ((eq where 'other-frame) + (switch-to-buffer-other-frame buffer)) + (t + (error "Invalid argument, where=%s" where)))) + +;; FIXME: face, var +(defun mlinks-custom (var) + (customize-option var) + ) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AppMenu support + +(defun mlinks-appmenu () + (when mlinks-mode + ;; Fix-me: reverse the list + (let ((link-val (mlinks-link-at-point)) + (map (make-sparse-keymap "mlinks")) + (num 2)) + (when (mlinks-get-mode-value 'prev) + (define-key map [mlinks-next-link] + (list 'menu-item "Next Link" 'mlinks-forward-link))) + (when (mlinks-get-mode-value 'next) + (define-key map [mlinks-prev-link] + (list 'menu-item "Previous Link" 'mlinks-backward-link))) + (when link-val + (let* ((possible (when (member major-mode '(html-mode nxhtml-mode nxml-mode sqml-mode text-mode)) + (mlinks-html-possible-href-actions link-val))) + (mailto (assoc 'mailto possible)) + (view-web (assoc 'view-web possible)) + (view-web-base (assoc 'view-web-base possible)) + (edit (assoc 'edit possible)) + (file (nth 1 edit)) + (anchor (nth 2 edit)) + (choices) + (answer) + ) + (when (> (length map) num) + (define-key map [mlinks-href-sep] (list 'menu-item "--"))) + (setq num (length map)) + (when view-web + (define-key map [mlinks-href-view-web] + (list 'menu-item "Browse Link Web Url" + `(lambda () (interactive) + (browse-url ,link-val))))) + (when view-web-base + (define-key map [mlinks-href-view-web-based] + (list 'menu-item "Browse Link Web Url (base URL found)" + `(lambda () (interactive) + (browse-url (cdr ,view-web-base)))))) + (when mailto + (define-key map [mlinks-href-mail] + (list 'menu-item (concat "&Mail to " (substring link-val 7)) + `(lambda () (interactive) + (mlinks-html-mail-to ,link-val))))) + (when edit + (when (and (file-exists-p file) + (not anchor) + (assoc 'upload possible)) + (let ((abs-file (expand-file-name file))) + (define-key map [mlinks-href-upload] + (list 'menu-item "Upload Linked File" + `(lambda () (interactive) + (html-upl-upload-file ,abs-file)))))) + (when (and (file-exists-p file) + (not anchor) + (assoc 'edit-gimp possible)) + (let ((abs-file (expand-file-name file))) + (define-key map [mlinks-href-edit-gimp] + (list 'menu-item "Edit Linked File with GIMP" + `(lambda () (interactive) + (gimpedit-edit-file ,abs-file)))))) + (when (and (file-exists-p file) + (assoc 'view-local possible)) + (let ((url (concat "file:///" (expand-file-name file)))) + (when anchor + (let ((url-anchor (concat url "#" anchor))) + (define-key map [mlinks-href-view-file-at] + (list 'menu-item (concat "Browse Linked File URL at #" anchor) + `(lambda () (interactive) + (browse-url ,url-anchor)))))) + (define-key map [mlinks-href-view-file] + (list 'menu-item "&Browse Linked File URL" + `(lambda () (interactive) + (browse-url ,url)))))) + (when (> (length map) num) + (define-key map [mlinks-href-sep-2] (list 'menu-item "--"))) + (setq num (length map)) + (unless (equal file (buffer-file-name)) + (define-key map [mlinks-href-edit] + (list 'menu-item "&Open Linked File" + `(lambda () (interactive) (mlinks-goto)))) + (define-key map [mlinks-href-edit-window] + (list 'menu-item "&Open Linked File in Other Window" + `(lambda () (interactive) (mlinks-goto-other-window)))) + (define-key map [mlinks-href-edit-frame] + (list 'menu-item "&Open Linked File in New Frame" + `(lambda () (interactive) (mlinks-goto-other-frame)))) + ) + (when (and (file-exists-p file) anchor) + (define-key map [mlinks-href-edit-at] + (list 'menu-item (concat "Open Linked File &at #" anchor) + `(lambda () (interactive) + (mlinks-goto))))) + ) + (when (> (length map) num) + (define-key map [mlinks-href-sep-1] (list 'menu-item "--"))) + (setq num (length map)) + (when link-val + (define-key map [mlinks-href-copy-link] + (list 'menu-item "&Copy Link Text" + 'mlinks-copy-link-text))))) + (when (> (length map) 2) + map)))) + +(defun mlinks-add-appmenu () + "Add entries for MLinks to AppMenu." + (when (featurep 'appmenu) + (appmenu-add 'mlinks 100 'mlinks-mode "Current MLink" 'mlinks-appmenu))) + +(defun mlinks-copy-link-text () + "Copy text of `mlinks-mode' link at point to clipboard." + (interactive) + (mlinks-point-hilighter) + (let ((ovl mlinks-point-hilighter-overlay)) + (if (and ovl + (overlayp ovl) + (overlay-buffer ovl) + (eq (current-buffer) + (overlay-buffer ovl)) + (<= (overlay-start ovl) + (point)) + (>= (overlay-end ovl) + (point))) + (let* ((beg (overlay-start ovl)) + (end (overlay-end ovl)) + (str (buffer-substring beg end))) + (copy-region-as-kill beg end) + (message "Copied %d chars to clipboard" (length str))) + (message "No link here to copy")))) + + + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;; text-mode etc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar mlinks-plain-urls-regexp + (rx-to-string `(or (submatch (optional "mailto:") + (regexp ,(concat + ;;"[a-z0-9$%(*-=?[_][^<>\")!;:,{}]*" + "[a-z0-9$%(*=?[_-][^<>\")!;:,{}]*" + "\@" + "\\(?:[a-z0-9\-]+\.\\)+[a-z0-9]\\{2,4\\}"))) + (submatch (or (regexp "https?://") + "www.") + (1+ (any ,url-get-url-filename-chars)) + ) + ))) + +(defun mlinks-plain-urls-fontify (bound) + (mlinks-fontify bound mlinks-plain-urls-regexp 0)) + +(defun mlinks-goto-plain-url () + (let* ((range (mlinks-link-range (point))) + (link (when range (buffer-substring-no-properties (car range) (cdr range))))) + ;;(mlinks-html-href-act-on link) + (when (= 0 (string-match mlinks-plain-urls-regexp link)) + (let ((which (if (match-end 1) 1 2))) + (cond + ((= 1 which) + (mlinks-html-mail-to link) + t) + ((= 2 which) + (browse-url link) + t) + (t nil)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;; nxhtml-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun mlinks-html-style-goto () + (mlinks-html-style-mode-fun t)) + +(defvar mlinks-html-link-regexp + ;; This value takes care of nxhtml-strval-mode (and is therefore a little bit incorrect ...) + ;;"\\(?:^\\|[[:space:]]\\)\\(?:href\\|src\\)[[:space:]]*=[[:space:]]*\"\\([^<«\"]*\\)\"" + (rx (or "^" space) + (or "href" "src") + (0+ space) + "=" + (0+ space) + (submatch + (or + (seq "\"" + (and + (0+ (not (any "\"")))) + "\"") + (seq "'" + (and + (0+ (not (any "\'")))) + "'"))))) + +(defun mlinks-html-style-mode-fun (goto) + (let (start + end + bounds) + (save-excursion + (forward-char) + (when (< 0 (skip-chars-forward "^\"'" (line-end-position))) + (forward-char) + (save-match-data + (when (looking-back + mlinks-html-link-regexp + (line-beginning-position -1)) + (let ((which (if (match-beginning 1) 1 2))) + (setq start (1+ (match-beginning which))) + (setq end (1- (match-end which)))) + (setq bounds (cons start end)))))) + (when start + (if (not goto) + bounds + (let ((href-val (buffer-substring-no-properties start end))) + (mlinks-html-href-act-on href-val)) + t)))) + +(defun mlink-check-file-to-edit (file) + (assert (file-name-absolute-p file)) + (let ((file-dir (file-name-directory file))) + (unless (file-directory-p file-dir) + (if (file-directory-p (file-name-directory file)) + (if (yes-or-no-p (format "Directory %s does not exist. Create it? " file-dir)) + (make-directory file-dir) + (setq file nil)) + (if (yes-or-no-p (format "Directory %s and its parent does not exist. Create them? " file-dir)) + (make-directory file-dir t) + (setq file nil)))) + file)) + +(defun mlinks-html-edit-at (file &optional anchor) + (let ((abs-file (if (file-name-absolute-p file) + file + (expand-file-name file)))) + (if (or (file-directory-p abs-file) + (string= abs-file + (file-name-as-directory abs-file))) + (if (file-directory-p abs-file) + (when (y-or-n-p (format "Do you want to edit the directory %s? : " abs-file)) + (dired abs-file)) + (message "Can't find directory %s" abs-file)) + (when (mlink-check-file-to-edit abs-file) + (let ((b (find-file-noselect abs-file))) + (mlinks-switch-to-buffer b)) + (when anchor + (let ((here (point)) + (anchor-regexp (concat "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\"" anchor "\""))) + (goto-char (point-min)) + (if (search-forward-regexp anchor-regexp nil t) + (backward-char 2) + (message "Anchor \"%s\" not found" anchor) + (goto-char here)))))))) + +(defun mlinks-html-mail-to (addr) + (browse-url addr)) + +(defun mlinks-html-href-act-on (href-val) + (if href-val + (let* ((possible (mlinks-html-possible-href-actions href-val)) + (edit (assoc 'edit possible)) + (file (nth 1 edit)) + (anchor (nth 2 edit)) + ) + (cond (edit + (mlinks-html-edit-at file anchor) + t) + ((assoc 'mailto possible) + (when (y-or-n-p "This is a mail address. Do you want to send a message to this mail address? ") + (mlinks-html-mail-to href-val))) + ((assoc 'view-web possible) + (when (y-or-n-p "Can't edit this URL, it is on the web. View the URL in your web browser? ") + (browse-url href-val))) + ((assoc 'view-web-base possible) + (when (y-or-n-p "Can't edit, based URL is to the web. View resulting URL in your web browser? ") + (browse-url (cdr (assoc 'view-web-base possible))))) + (t + (message "Do not know how to handle this URL")) + )) + (message "No value for href attribute"))) + +(defun mlinks-html-possible-href-actions (link) + (let ((urlobj (url-generic-parse-url link)) + (edit nil) + (possible nil)) + (cond ((member (url-type urlobj) '("http" "https")) + (add-to-list 'possible (cons 'view-web link))) + ((member (url-type urlobj) '("mailto")) + (add-to-list 'possible (cons 'mailto link))) + ((url-host urlobj) + (message "Do not know how to handle this URL")) + (t (setq edit t))) + (when edit + (let ((base-href (mlinks-html-find-base-href))) + (when base-href + (let ((baseobj (url-generic-parse-url base-href))) + (setq edit nil) + (cond ((member (url-type baseobj) '("http" "https")) + (add-to-list 'possible (cons 'view-web-base (url-expand-file-name link base-href)))) + ((url-host urlobj) + (message "Do not know how to handle this URL")) + (t (setq edit t))))) + (when edit + (let* ((full (split-string (url-filename urlobj) "#")) + (file (nth 0 full)) + (anchor (nth 1 full)) + ) + (when (equal file "") + (setq file (buffer-file-name))) + (when base-href + ;; We know at this point it is not a http url + (setq file (expand-file-name file base-href))) + (let ((ext (downcase (file-name-extension file)))) + (when (member ext '("htm" "html")) + (add-to-list 'possible (cons 'view-local (list file anchor)))) + (when (and (featurep 'gimpedit) + (member ext '("gif" "png" "jpg" "jpeg"))) + (add-to-list 'possible (cons 'edit-gimp (list file anchor))))) + (when (featurep 'html-upl) + (add-to-list 'possible (cons 'upload (list file anchor)))) + (add-to-list 'possible (cons 'edit (list file anchor))))))) + possible)) + +(defun mlinks-html-find-base-href () + "Return base href found in the current file." + (let ((base-href)) + (save-excursion + (goto-char (point-min)) + (while (and (not base-href) + (search-forward-regexp "<!--[^!]*-->\\|<base[[:space:]]" nil t)) + (when (equal " " (char-to-string (char-before))) + (backward-char 6) + (when (looking-at "<base [^>]*href *= *\"\\(.*?\\)\"") + (setq base-href (match-string-no-properties 1)))))) + base-href)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;; Custom-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun mlinks-elisp-custom-goto () + (mlinks-elisp-mode-fun 'custom)) + +(defvar mlinks-custom-link-regexp + (rx "`" + (group + (1+ (not (any "'")))) + "'")) + +(defun mlinks-custom-fontify (bound) + (mlinks-fontify bound mlinks-custom-link-regexp 0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;; emacs-lisp-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun mlinks-elisp-goto () + (mlinks-elisp-mode-fun 'source)) + +(defun mlinks-elisp-hili () + (mlinks-elisp-mode-fun nil)) + +(defun mlinks-elisp-mode-fun (goto) + (let ((symbol-name (thing-at-point 'symbol))) + (when symbol-name + (let ((bounds-- (bounds-of-thing-at-point 'symbol)) + ret--) + (if (save-excursion + (goto-char (cdr bounds--)) + (looking-back (concat "(\\(?:require\\|featurep\\)\s+'" symbol-name) + (line-beginning-position))) + (progn + (setq ret-- bounds--) + (when goto + (mlinks-elisp-mode-require symbol-name))) + (when (mlinks-elisp-mode-symbol symbol-name goto) + (setq ret-- bounds--))) + ret--)))) + +(defun mlinks-elisp-function (symbol) + "Go to an elisp function." + (interactive "aElisp function: ") + (mlinks-elisp-mode-symbol (symbol-name symbol) 'source)) + +(defun mlinks-elisp-mode-symbol (symbol-name-- goto--) + ;; Fix-me: use uninterned variables (see mail from Miles) + ;; Make these names a bit strange because they are boundp at the time of checking: + (let ((symbol-- (intern-soft symbol-name--)) + defs--) + (when (and symbol-- (boundp symbol--)) + (add-to-list 'defs-- 'variable)) + (when (fboundp symbol--) + (add-to-list 'defs-- 'function)) + (when (facep symbol--) + (add-to-list 'defs-- 'face)) + ;; Avoid some fails hits + (when (memq symbol-- + '(goto t + bounds-- funs-- ret-- + symbol-- defs-- symbol-name-- goto--)) + (setq defs-- nil)) + (let (defs-places + def) + (if (not goto--) + (progn + defs--) + (if (not defs--) + (progn + (message "Could not find definition of '%s" symbol-name--) + nil) + (dolist (type (cond + ((eq goto-- 'source) + '(nil defvar defface)) + ((eq goto-- 'custom) + '(defvar defface)) + (t + (error "Bad goto-- value: %s" goto--)))) + (condition-case err + (add-to-list 'defs-places + (cons + type + (save-excursion + (let* ((bp (find-definition-noselect symbol-- type)) + (b (car bp)) + (p (cdr bp))) + (unless p + (with-current-buffer b + (save-restriction + (widen) + (setq bp (find-definition-noselect symbol-- type))))) + bp)))) + (error + ;;(lwarn '(mlinks) :error "%s" (error-message-string err)) + (when t + (cond + ((eq (car err) 'search-failed)) + ((and (eq (car err) 'error) + (string= (error-message-string err) + (format "Don't know where `%s' is defined" symbol--)))) + (t + (message "%s: %s" (car err) (error-message-string err)))))))) + (if (= 1 (length defs-places)) + (setq def (car defs-places)) + (let ((many nil) + lnk) + (dolist (d defs-places) + (if (not lnk) + (setq lnk (cdr d)) + (unless (equal lnk (cdr d)) + (setq many t)))) + (if (not many) + (setq def (car defs-places)) + (let* ((alts (mapcar (lambda (elt) + (let ((type (car elt)) + str) + (setq str + (cond + ((not type) + "Function") + ((eq type 'defvar) + "Variable") + ((eq type 'defface) + "Face"))) + (cons str elt))) + defs-places)) + (stralts (mapcar (lambda (elt) + (car elt)) + alts)) + (completion-ignore-case t) + (stralt (completing-read "Type: " stralts nil t)) + (alt (assoc stralt alts))) + (setq def (cdr alt)))))) + (when def + (cond + ((eq goto-- 'source) + ;; Be sure to go to the real sources from CVS: + (let* ((buf (car (cdr def))) + ;; Avoid going to source + ;;(file (find-source-lisp-file (with-current-buffer buf buffer-file-name)) ) + (file (with-current-buffer buf buffer-file-name)) + (orig-buf (find-file-noselect file))) + (mlinks-switch-to-buffer orig-buf) + (let ((p (cdr (cdr def)))) + ;; Fix-me: Move this test to a more general place. + (if (or (< p (point-min)) + (> p (point-max))) + ;; Check for cloned indirect buffers. + (progn + (setq orig-buf + (catch 'view-in-buf + (dolist (indirect-buf (buffer-list)) + ;;(message "base-buffer=%s, orig-buf=%s, eq => %s" (buffer-base-buffer indirect-buf) orig-buf (eq (buffer-base-buffer indirect-buf) orig-buf)) + (when (eq (buffer-base-buffer indirect-buf) orig-buf) + (with-current-buffer indirect-buf + ;;(message "indirect-buf=%s" indirect-buf) + (unless (or (< p (point-min)) + (> p (point-max))) + ;;(message "switching") + ;;(mlinks-switch-to-buffer indirect-buf) + (message "mlinks: Switching to indirect buffer because of narrowing") + (throw 'view-in-buf indirect-buf) + )) + )))) + (when orig-buf + (mlinks-switch-to-buffer orig-buf)) + ;;(message "cb=%s" (current-buffer)) + (if (or (< p (point-min)) + (> p (point-max))) + (when (y-or-n-p (format "%s is invisible because of narrowing. Widen? " symbol--)) + (widen) + (goto-char p)) + (goto-char p))) + (goto-char p))))) + ((eq goto-- 'custom) + (mlinks-custom symbol--)) + (t + (error "Back goto-- value again: %s" goto--))))))))) + +(defun mlinks-elisp-mode-require (module) + (let ((where mlinks-temp-buffer-where)) + (cond + ((null where) + (find-library module)) + ((eq where 'other-window) + (other-window 1) + (find-library module)) + ((eq where 'other-frame) + (make-frame-command) + (find-library module)) + (t + (error "Invalid argument, where=%s" where))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;; Helpers when adopting for modes ;;;;;;;;;;;;;;;;; + +;;; Save this, do not delete this comment: + +;; (defun mlinks-hit-test () +;; "Just a helper function for adding support for new modes." +;; (let* ( +;; (s0 (if (match-string 0) (match-string 0) "")) +;; (s1 (if (match-string 1) (match-string 1) "")) +;; (s2 (if (match-string 2) (match-string 2) "")) +;; (s3 (if (match-string 3) (match-string 3) "")) +;; ) +;; (message "match0=%s, match1=%s, match2=%s, match3=%s" s0 s1 s2 s3))) + +;; (defun mlinks-handle-reg-fun-list (reg-fun-list) +;; "Just a helper function." +;; (let (done +;; regexp +;; hitfun +;; m +;; p +;; b +;; ) +;; (dolist (rh reg-fun-list) +;; (message "rh=%s" rh);(sit-for 2) +;; (unless done +;; (setq regexp (car rh)) +;; (setq hitfun (cadr rh)) +;; (message "regexp=%s, hitfun=%s" regexp hitfun);(sit-for 1) +;; (when (and (save-match-data +;; (setq m (re-search-backward regexp (line-beginning-position) t)) +;; (> p (match-beginning 0)))) +;; (setq done t) +;; (setq b (match-beginning 0)) +;; (setq e (match-end 0)) +;; ) +;; (if (not (and b e +;; (< b p) +;; (< p e))) +;; (message "MLinks Mode did not find any link here") +;; (goto-char b) +;; (if (not (looking-at regexp)) +;; (error "Internal error, regexp %s, no match looking-at" regexp) +;; (let ((last (car mlinks-places)) +;; (m (make-marker))) +;; (set-marker m (line-beginning-position)) +;; (when (or (not last) +;; (/= m last)) +;; (setq mlinks-places (cons m mlinks-places)))) +;; (funcall hitfun)) +;; ))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Font Lock use + +(defvar mlinks-link-update-pos-max nil) +(make-variable-buffer-local 'mlinks-link-update-pos-max) +(put 'mlinks-link-update-pos-max 'permanent-local t) + +(defun mlinks-remove-font-lock () + "Remove info from font-lock." + (when (mlinks-want-font-locking) + (mlink-font-lock nil))) + +(defun mlinks-add-font-lock () + "Add info to font-lock." + (when (mlinks-want-font-locking) + (mlink-font-lock t))) + +(defun mlinks-want-font-locking () + (or (mlinks-get-mode-value 'fontify) + (mlinks-get-mode-value 'next-mark))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Font Lock integration + +(defun mlink-font-lock (on) + (let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords)) + (fontify-fun (car (mlinks-get-mode-value 'fontify))) + (args (list nil `(( ,fontify-fun ( 0 mlinks-font-lock-face t )))))) + (when fontify-fun + ;; Note: Had a lot of trouble with this which I modelled first + ;; after dlink. Using hi-lock as a model made it work with + ;; mumamo too. + ;; + ;; Next arg, HOW, is needed to get it to work with mumamo. This + ;; adds it last, like hi-lock. + (when on (setq args (append args (list t)))) + (apply add-or-remove args) + (font-lock-mode -1) + (font-lock-mode 1)))) + +(defun mlinks-html-fontify (bound) + (mlinks-fontify bound mlinks-html-link-regexp 1)) + +(defun mlinks-fontify (bound regexp border) + (let ((start (point)) + end-start + stop next-stop + (more t) + old-beg old-end + (wn 1) + ret) + ;; Note: we shouldnot use save-match-data here. Instead + ;; set-match-data is called below! + (if (not (re-search-forward regexp bound t)) + (setq end-start bound) + (setq ret t) + (setq end-start (- (point) 2)) + (let* ((which (if (match-beginning 1) 1 2)) + (beg (+ (match-beginning which) border)) + (end (- (match-end which) border))) + (put-text-property beg end 'mlinks-link t) + (set-match-data (list (copy-marker end) (copy-marker beg))))) + (setq stop start) + (setq next-stop -1) + (while (and (> 100 (setq wn (1+ wn))) + (setq next-stop (next-single-char-property-change stop 'mlinks-link nil end-start)) + (/= next-stop stop)) + (setq stop next-stop) + (if (get-text-property stop 'mlinks-link) + (setq old-beg stop) + (when old-beg + (remove-list-of-text-properties old-beg stop '(mlinks-link 'mouse-face))))) + ret)) + +(defun mlinks-next-link () + "Find next link, fontify as necessary." + (let* ((here (point)) + (prev-pos (point)) + (fontified-here (get-text-property (max (point-min) (1- prev-pos)) 'fontified)) + (fontified-to (next-single-char-property-change prev-pos 'fontified)) + (pos (next-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-to (point-max)))) + (fontified-all (and fontified-here (not fontified-to))) + ready + next-fontified-to) + (while (not (or ready + (and fontified-all + (not pos)))) + (if pos + (progn + (unless (get-text-property pos 'mlinks-link) + ;; Get to next link + (setq prev-pos pos) + (setq pos (next-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-to (point-max))))) + (when pos + (setq ready (get-text-property pos 'mlinks-link)) + (setq prev-pos pos) + (unless ready (setq pos nil)))) + (unless (or fontified-all fontified-to) + (if (get-text-property prev-pos 'fontified) + (setq fontified-all + (not (setq fontified-to + (next-single-char-property-change prev-pos 'fontified)))) + (setq fontified-to ( or (previous-single-char-property-change prev-pos 'fontified) + 1)))) + (setq next-fontified-to (min (+ fontified-to 5000) + (point-max))) + (mumamo-with-buffer-prepared-for-jit-lock + (progn + (put-text-property fontified-to next-fontified-to 'fontified t) + (font-lock-fontify-region fontified-to next-fontified-to))) + (setq fontified-to (next-single-char-property-change (1- next-fontified-to) + 'fontified)) + (setq fontified-all (not fontified-to)) + (setq pos (next-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-to (point-max)))))) + (when ready prev-pos))) + +(defun mlinks-prev-link () + "Find previous link, fontify as necessary." + (let* ((prev-pos (point)) + (fontified-from (previous-single-char-property-change prev-pos 'fontified)) + (fontified-here (get-text-property (max (point-min) (1- prev-pos)) 'fontified)) + (fontified-all (and fontified-here (not fontified-from))) + (pos (when fontified-here + (previous-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-from 1)))) + ready + next-fontified-from) + (while (not (or ready + (and fontified-all + (not pos)))) + (assert (numberp prev-pos) t) + (if pos + (progn + (when (and (> (1- pos) (point-min)) + (get-text-property (1- pos) 'mlinks-link)) + ;; Get out of current link + (setq prev-pos pos) + (setq pos (previous-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-from 1)))) + (when pos + (setq prev-pos pos) + (setq ready (and (get-text-property pos 'fontified) + (or (= 1 pos) + (not (get-text-property (1- pos) 'mlinks-link))) + (get-text-property pos 'mlinks-link))) + (unless ready (setq pos nil)))) + (setq next-fontified-from (max (- fontified-from 5000) + (point-min))) + (mumamo-with-buffer-prepared-for-jit-lock + (progn + (put-text-property next-fontified-from fontified-from 'fontified t) + (font-lock-fontify-region next-fontified-from fontified-from))) + (setq fontified-from (previous-single-char-property-change + (1+ next-fontified-from) 'fontified)) + (setq fontified-all (not fontified-from)) + (setq pos (previous-single-char-property-change prev-pos 'mlinks-link nil + (or fontified-from 1))))) + (when ready pos))) + + +;;; This is for the problem reported by some Asian users: +;;; +;;; Lisp error: (invalid-read-syntax "] in a list") +;;; +;; Local Variables: +;; coding: utf-8 +;; End: + +(provide 'mlinks) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mlinks.el ends here |