path: root/scripts/kde-emacs/kde-emacs-utils.el

;; kde-emacs-utils.el
;;
;; Copyright (C)  2002-2005  KDE Development Team <www.kde.org>
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Steet, Fifth Floor, Boston, MA
;; 02110-1301  USA


(require 'kde-emacs-vars)
(require 'kde-emacs-general)
(require 'kde-emacs-compat)

(if (eq kde-emacs-type 'xemacs)
    (progn
      (require 'func-menu)
      (add-hook 'find-file-hooks 'fume-add-menubar-entry))
  (require 'imenu))

(defmacro c-safe-scan-lists (from count depth)
  "Like `scan-lists' but returns nil instead of signalling errors.
This function does not do any hidden buffer changes."
  (if (featurep 'xemacs)
      `(scan-lists ,from ,count ,depth nil t)
    `(c-safe (scan-lists ,from ,count ,depth))))

;; returns non-nil if the given file has a using declaration
;; with the passed namespace
(defun kde-file-has-using (namespace)
  (let (found)
    (save-excursion
      (beginning-of-buffer)
      (set found (re-search-forward "^using" nil 1))
      (if found
	  (set found (search-forward namespace (line-end-position) 1))
	)
      )
    found)
  )

;; returns non-nill if the given file has a "namespace SomeNM" declaration
;; where SomeNM is passed via the namespace argument
(defun kde-file-is-in-namespace (namespace)
  (let (found)
    (save-excursion
      (beginning-of-buffer)
      (set found (re-search-forward "^namespace" nil 1))
      (if found
	  (set found (search-forward namespace (line-end-position) 1))
	)
      )
    found)
  )

; Helper function for parsing our current position in a C++ header file
; returns (namespace (class function)) where (a b) is a cons.
(defun method-under-point ()
  (let ((class nil)
        (namespace "") ; will contain A::B::
        (function nil))
    (save-excursion
      (backward-char)             ; in case we're after the ';'
      (search-forward ";" nil t)  ; look for the ';'
      (backward-char)
      (save-excursion
        ; Go up a level, skipping entire classes etc.
        ; This is a modified version of (backward-up-list) which doesn't
        ; throw an error when not found.
	(let ((pos (c-safe-scan-lists (point) -1 1)))
	; +1 added here so that the regexp in the while matches the { too.
	  (goto-char (if pos (+ pos 1) (point-min))))
	(while (re-search-backward "^[ ]*\\(class\\|namespace\\|struct\\)[ \t][^};]*{" nil t)
	  (save-excursion
	    (forward-word 1)
	   (when (looking-at "[ \t]*[A-Z_]*_EXPORT[A-Z_]*[ \t]")
	     (forward-word 1)
	     (re-search-forward "[ \t]" nil t))
	    (while (looking-at "[ \t]")
	      (forward-char 1))
	    (set start (point))
	    ; Parse class name ("Foo" or "Foo::Bar::Blah"). 
	    ; Beware of "Foo:"
	    (while (or (looking-at "[A-Za-z0-9_]") (looking-at "::"))
	      (while (looking-at "[A-Za-z0-9_]")
		(forward-char 1))
	      (while (looking-at "::")
		(forward-char 2))
	      )
	    (cond
	     (class			; class found already, so the rest goes into the namespace
	      (set namespace (concat (buffer-substring start (point)) "::" namespace)))
	     (t				; class==nil
	      (set class (buffer-substring start (point)))))
	    )
        ; Go up one level again
	(let ((pos (c-safe-scan-lists (point) -1 1)))
	  (goto-char (if pos (+ pos 1) (point-min))))
	))

    ; Back to where we were, parse function name
    (let ((end (point)))          ; remember where the function decl ends
      (search-backward ")" nil t) ; look back for the end of the argument list
      (forward-char)
      (backward-sexp)             ; brings us back to the '('
      (backward-word 1)
      (when (looking-at "throw[ \t]") ; exception specification, look for () again
             (search-backward ")" nil t)
             (forward-char)
             (backward-sexp))
      ; now that we moved back enough, go to beginning of line.
      ; (we assume that the return type, function name, and '(' are on the same line)
      (re-search-backward "^[ \t]*")
      (while (looking-at "[ \t]")
	(forward-char 1))
      (set function (buffer-substring (point) end))
      )
    ) ; end of global save-excursion
    (cons namespace (cons class function)) ; the returned value
    )
  )

; get rid of virtual, static, multiple spaces, default values.
(defun canonical-function-sig (function)
  (and (string-match "[ \t]*\\<virtual\\>[ \t]*" function)
       (set function (replace-match " " t t function)))
  (and (string-match "^\\(virtual\\>\\)?[ \t]*" function)
       (set function (replace-match "" t t function)))
  (and (string-match "^\\(explicit\\>\\)?[ \t]*" function)
       (set function (replace-match "" t t function)))
  (and (string-match "^\\(static\\>\\)?[ \t]*" function)
       (set function (replace-match "" t t function)))
  (while (string-match "  +" function) ; simplifyWhiteSpace
    (set function (replace-match " " t t function)))
  (while (string-match "\t+" function)
    (set function (replace-match " " t t function)))
  (while (string-match "^ " function)  ; remove leading whitespace
    (set function (replace-match "" t t function)))
  (let ((startargs (string-match "(" function)))
    (while (string-match " ?=[^,)]+" function startargs) ; remove default values
      (set function (replace-match " " t t function))))
  (while (string-match " +," function) ; remove space before commas
    (set function (replace-match "," t t function)))
  function ; the return value
)

; Helper method which turns the function as seen in the header
; into the signature for its implementation
; Returns the fully-qualified signature of the function implementation
(defun kde-function-impl-sig (namespace class _function)
  (let (
	(function (canonical-function-sig _function))
	(insertion-string nil))
    (and (stringp class)
	 (cond
	  ((string-match (concat "^ *" class "[ \\t]*(") function) ; constructor
	   (set insertion-string
		 (replace-match
		  (concat namespace class "::" class "(")
		  t t function)
		 ))
	  ((string-match (concat "^ *~" class "[ \\t]*(") function) ; destructor
	   (set insertion-string
		 (replace-match
		  (concat namespace class "::~" class "(")
		  t t function)
		 ))
	  ))				; end of "class required"
    (if (not (stringp insertion-string)) ; no ctor nor dtor
	(if (or (string-match " *\\([a-zA-Z0-9_]+\\)[ \\t]*(" function) ; normal method
		(string-match " *\\(operator[^ \\t]+\\)[ \\t]*(" function)) ; operator
	      (set insertion-string
		    (replace-match
		     (if class
			 (concat " " namespace class "::" "\\1(") ; c++ method
		       (concat " " "\\1(")) ; c function
		     t nil function)
		    )
					; else
	  (error (concat "Can't parse declaration ``"
			 function "'' in class ``" class
			 "'', aborting"))))
    insertion-string ; the return value
    )
  )

;; Switch between the declaration of a class member in .cc/.cpp/.C, and its definition in the .h file
;; Written by David and Reggie after much hair tearing
;; Found since, might be worth looking at: http://www.hendawi.com/emacs/sourcepair.el
(defun switch-to-function-def ()
  (interactive)
  (let ((n (buffer-file-name))
        (namespace "")
        (class "")
        (function "")
        found
	)
    (if (or (string-match "\\.cc$" n)
            (string-match "\\.cpp$" n)
            (string-match "\\.C$" n))
        ; TODO replace fume-function-before-point, needed for emacs,
        ; and for better namespace support.
	;(progn
	;  (let ((pos (kde-scan-lists (point) -1 1 nil t))) ; Go up a level
	;    (goto-char (if pos (+ pos 1) (point-min))))
        (let ((a (fume-function-before-point)))
          (and (string-match "^\\(.*\\)::\\(.*\\)$" a)
               (progn
                 (set class (match-string 1 a))
                 (set function (match-string 2 a))
                 (kde-switch-cpp-h)
                 (goto-char 0)
		 ; Look for beginning of class ("\\s-+" means whitespace including newlines)
                 (re-search-forward
		  (concat "\\(class\\|struct\\|namespace\\)\\s-+"
			  "\\([A-Z_]+_EXPORT[A-Z_]*\\)?\\s-+"  ; allow for optional EXPORT macro
			  class "\\b"                          ; the classname - with word separator
			  "[^;]+{"                             ; the optional inheritance and the '{'
			  ) nil t)
                 ;; TODO keep looking, until we find a match that's not inside a comment
                 (re-search-forward (concat "\\b" (kde-function-regexp-quote function) "[ \t]*(") nil t)))))
    (if (string-match "\\.h$" n)
        (progn
	  (let ((mup (method-under-point))
		(sig "")
		(pos 0))
        (set namespace (car mup))
	    (set class (car (cdr mup)))
	    (set function (cdr (cdr mup)))
	    (kde-switch-cpp-h)

        ;; First search with namespace prefixed
	    (goto-char 0)
	    (set sig (kde-remove-newline (kde-function-impl-sig namespace class function)))
	    (if (string-match "(.*" sig) ; remove args
		(set sig (replace-match "" nil t sig)))
	    (set found (re-search-forward (concat "^[^()]*" (kde-function-regexp-quote sig) "[ \t]*(") nil t) )

        (if (not found)
            (progn
              ; Now search without name space prefix

              (goto-char 0)
              (set sig (kde-remove-newline (kde-function-impl-sig "" class function)))
              
              (if (string-match "(.*" sig) ; remove args
                  (set sig (replace-match "" nil t sig)))
              (re-search-forward (concat "^[^()]*" (kde-function-regexp-quote sig) "[ \t]*(") nil t) ) )
	    )))))

(defun kde-remove-newline (str) 
    (replace-in-string str "\n" " "))
; quote for use as regexp, but replace spaces with "any whitespace"
(defun kde-function-regexp-quote (str)
  (replace-in-string (regexp-quote str) "[ \n\t]" "[ \n\t]"))

; Initial implementation by Arnt Gulbransen
; Current maintainer: David Faure
(defun agulbra-make-member ()
  "make a skeleton member function in the .cpp or .cc file"
  (interactive)
  (let* (
	 (mup (method-under-point))
	 (namespace (car mup))  ; will contain A::B::
	 (class (car (cdr mup)))
	 (function (cdr (cdr mup)))
	 (file (buffer-file-name))
	 (insertion-string (kde-function-impl-sig namespace class function))
	 (msubstr nil)
	 (start nil)
	 (newcppfile nil)
	 )
    (set insertion-string 
	  (concat insertion-string "\n{\n"
		  (replace-in-string kde-make-member-default-impl "FUNCTION" 
				     ; the function name and args, without newlines
				     (replace-in-string insertion-string "\n" " " t)
				     t)
		  "}\n"))
    ; move to next method, to be ready for next call
    (backward-char)                ; in case we're after the ';'
    (re-search-forward ";" nil t)  ; end of this method decl
    (let ((moveToNext t))
      (while moveToNext
	(re-search-forward ";" nil t)  ; end of next method decl
	(save-excursion
	  (forward-char -2) ; -1 goes to ';' itself, so go before that
	  (while (looking-at "[ \t0=]")
	    (forward-char -1))
	  (forward-char 1)
          ; move to next method again if we're at a pure virtual method
	  (set moveToNext (looking-at "[ \t]*=[ \t]*0;"))
	  )
	)
      )

    (set newcppfile (not (cdr (kde-file-get-cpp-h))))
    (if (string-match "\\.h$" file)
	(kde-switch-cpp-h)
      )
    (goto-char (point-max))    
    (kde-comments-begin)
    (kde-skip-blank-lines)
    (set msubstr (buffer-substring (point-at-bol) (point-at-eol)))
    (if (string-match "^#include.*moc.*" msubstr)
	(progn 
	  (forward-line -1)
	  (end-of-line)
	  (insert "\n")))
    (if (string-match "}" msubstr)
	(progn
	  (end-of-line)
	  (insert "\n")
	  (forward-line 1)
	  ))
    (when newcppfile
      (insert "\n"))
    (insert insertion-string)
    (forward-char -3)
    (c-indent-defun)   
    (save-excursion
      (and (string-match ".*/" file)
	   (set file (replace-match "" t nil file)))
      (and (string-match "\\.h$" file)
	   (functionp 'kdab-insert-include-file)
	   (kdab-insert-include-file file 't nil)))
    (when (featurep 'fume-rescan-buffer)
      (fume-rescan-buffer))
    ))

(defun add-file-to-buildsystem ()
  "Add the current (C++) file to either Makefile.am or a .pro file, whichever exists."
  ; Author: David
  (interactive)
  (if (file-readable-p "Makefile.am")
      (add-file-to-makefile-am)
    ; else: find a .pro file and add it there
    (let* ((files (directory-files "." nil ".pro$" nil t))
	   (projfile (car files)))
      (if projfile
	  (add-file-to-project projfile "^SOURCES[ \t]*") ; could be SOURCES= or SOURCES+=
	; else: error
	(error "No build system file found")
	)))
  )

; internal helper for add-file-to-*
(defun add-file-to-project (makefile searchString)
  (let ((file (buffer-name)))
    (if (not (file-readable-p makefile))
	(error (concat makefile " not found!"))
      )
    (find-file makefile)
    (goto-char (point-min))
    (if (re-search-forward searchString nil t)
	(progn
	  (end-of-line)
          ; check if line ends with '\' [had to read make-mode.el to find this one!]
	  (while (= (char-before) ?\\)
	    (end-of-line 2)) ; moves to end of next line
	  (insert " ")
	  (insert file)
	  )
      (error (concat searchString " not found"))
      ))
  )

(defun add-file-to-makefile-am ()
  "Add the current file to the first _SOURCES line in the Makefile.am"
  ; Author: David
  (interactive)
  (add-file-to-project "Makefile.am" "_SOURCES")
  )


; Inserts a kdDebug statement showing the name of the current method.
; You need to create the empty line first.
(defun insert-kdDebug ()
  (interactive)
  (insert "kdDebug() << ")
  ;; no unnecessary fume-* functions which aren't available on GNU/Emacs
  (insert "k_funcinfo")
  (insert " << endl;")
  )

; finds a string to be used in the header-protection function ( see below )
(defun kde-header-protection-definable-string ()
   (let* ((definablestring "")
	  (f (buffer-file-name))
	  (parts (nreverse (split-string f "/")))
	  (i)
	  (first-iter t)
	  (iters (min (length parts) kde-header-protection-parts-to-show)))
     (dotimes (i iters)
       (let ((part (pop parts)))
	 (set definablestring
	       (concat
		(upcase (replace-in-string part "[\\.-]" "_"))
		(if (not first-iter) "_" "")
		definablestring
		)
	       )
	 (set first-iter nil)
	 )
       )
     definablestring
     )
   )

; Creates the ifndef/define/endif statements necessary for a header file
(defun header-protection ()
  (interactive)
  (let ((s (kde-header-protection-definable-string)))
    (save-excursion
      (goto-char (point-min))
      (insert "#ifndef " s "\n#define " s "\n\n")
      (goto-char (point-max))
      (insert "\n#endif\n")
      )
    )
  )

; Makes '(' insert '(' or ' ( ' where appropiate
(defun insert-parens (arg) (interactive "*P")
  (if (not (c-in-literal))
      (let ((n nil) (except nil))
        (save-excursion
          (set n (or (progn (forward-char -2) (looking-at "if"))
                      (progn (forward-char -1) (looking-at "for"))
                      (progn (forward-char -1) (looking-at "case"))
                      (progn (forward-char -1) (looking-at "while"))
                      )
                )
          (set except (or (progn (forward-char -2) (looking-at "kdDebug"))
                           (looking-at "kdError")
                           (progn (forward-char -2) (looking-at "kdWarning"))
			   )
                )
          )
        (cond
         (n (progn
              (insert " ")
              (self-insert-command (prefix-numeric-value arg))
              (insert kde-emacs-after-parent-string)
              ))
         (t ;else
          (self-insert-command (prefix-numeric-value arg))
          (cond ((not except) (insert kde-emacs-after-parent-string)))
          )))
    (self-insert-command (prefix-numeric-value arg)))
  )

(defun insert-parens2 (arg) (interactive "*P")
  (if (not (c-in-literal))
      (let ((remv nil) (nospac nil))
        (forward-char -2)
        (set remv (looking-at "( ")) ; () -> we'll have to remove that space
        (forward-char 1)
        (set nospac ; no space to be added
              (or (looking-at " ")
                  (looking-at "(")
                  (save-excursion ; check for kdDebug(123
                    (while (looking-at "[0-9]")
                      (forward-char -1))
                    (forward-char -7)
                    (or (looking-at "kdDebug(")
			(looking-at "kdError(")
                           (progn (forward-char -2) (looking-at "kdWarning("))
			   )
		    )
                  )
              )
        (forward-char 1)
        (cond
         (remv (progn
                 (delete-backward-char 1)
                 (self-insert-command (prefix-numeric-value arg)))) ; the () case
         (nospac (self-insert-command (prefix-numeric-value arg))) ; no space to be added
         (t ;else
          (if abbrev-mode ; XEmacs
              (expand-abbrev))
          (insert kde-emacs-after-parent-string)
          (self-insert-command (prefix-numeric-value arg))
          ))) ; normal case, prepend a space
    ;;(blink-matching-open) ; show the matching parens
    (self-insert-command (prefix-numeric-value arg)))
  )

; Makes ',' insert ', '
(defun insert-comma (arg)
  (interactive "*P")
  (let* ((ch (char-after))
         (spacep (not (or (eq ch ? )
                          (c-in-literal)
                          arg))))
    (self-insert-command (prefix-numeric-value arg))
    (if spacep
	(insert " "))))

(defun insert-semicolon (arg)
  (interactive "*P")
    (self-insert-command (prefix-numeric-value arg))
    (newline-and-indent))

(defun insert-curly-brace (arg) (interactive "*P")
  (if (not (c-in-literal))
      (let ((n nil) (o nil)
	    (spacep nil) (c nil)
	    (oneliner nil))
        (save-excursion
	  (save-excursion
	    (if (re-search-forward "[a-zA-Z]" (point-at-eol) t)
		(set oneliner t)))
	  (forward-char -1)              ; These three lines are for the situation where
          (if (not (looking-at " "))     ; the user already have inserted a space after
              (forward-char 1)           ; the closing parenthesis
	    (set spacep t))
          (forward-char -2)
          (set o (looking-at "()"))
          (forward-char 1)
          (set n (looking-at ")"))
	  (if (and 
	       (not oneliner)
	       (not (eq
		    (count-lines (point-min) (point))
		    (count-lines (point-min) (point-max)))))
	      (progn
		(next-line 1)
		(beginning-of-line)
		(if (re-search-forward "[a-zA-Z]" (point-at-eol) t)
		    (set c (eq (car (car (c-guess-basic-syntax))) 'substatement)))
		)
	    )
          )
        (cond
         (n (progn
              (if (not spacep) (insert " "))
              (self-insert-command (prefix-numeric-value arg))
              (if (not c) (newline-and-indent))
	      (if oneliner (end-of-line))
             (save-excursion
	      (if c
		  (progn
		    (next-line 1)
		    (end-of-line)
		    ))
	      (newline-and-indent)
              (insert "}")(c-indent-line))
              (c-indent-line)
	     ))
         (o (progn
              (newline)
              (self-insert-command (prefix-numeric-value arg))
              (newline-and-indent)))
         (t (progn ;else
              (self-insert-command (prefix-numeric-value arg))
              (save-excursion
                (beginning-of-line)
                (c-indent-command))))
         ))
    (self-insert-command (prefix-numeric-value arg))
    )
)

;; have PelDel mode work
(put 'insert-parens 'pending-delete t)
(put 'insert-parens2 'pending-delete t)
(put 'insert-comma 'pending-delete t)
(put 'insert-curly-brace 'pending-delete t)
(put 'newline-and-indent 'pending-delete t)

; A wheel mouse that doesn't beep, unlike mwheel-install
(defun scroll-me-up () (interactive) (scroll-up 4))
(defun scroll-me-down () (interactive) (scroll-down 4))
(defun scroll-me-up-a-bit () (interactive) (scroll-up 1))
(defun scroll-me-down-a-bit () (interactive) (scroll-down 1))

; Compilation
(defun makeclean ()
  "Executes a \"make clean\" in the current directory"
  (interactive)
  (compile (concat kde-emacs-make " clean"))
  )

(defun make ()
  "Executes a \"make\" in the current directory"
  (interactive)
  (compile (concat kde-emacs-make " -k"))
  )

(defun makeinstall ()
  "Executes a \"make install\" in the current directory"
  (interactive)
  (compile (concat kde-emacs-make " -k install"))
  )

(defun makeinstallexec ()
  "Executes a \"make install-exec\" in the current directory"
  (interactive)
  (compile (concat kde-emacs-make " -k install-exec"))
  )

(defun makethisfile ()
  "Try to compile the currently opened file"
  (interactive)
  (let ((f (file-name-nondirectory (buffer-file-name)))
	(objext nil))

    (if (file-readable-p "Makefile.am")
	(set objext "\.lo")
      (set objext "\.o"))
    (if (string-match "\.cpp$" f) (set f (replace-match objext t t f)))
    (if (string-match "\.cc$" f) (set f (replace-match objext t t f)))
    (compile (concat kde-emacs-make " " f)))
  )

;; pc-like textmarking
(when kde-use-pc-select
  (progn
    (load "pc-select")
    (if (eq kde-emacs-type 'xemacs)
       (funcall 'pc-select-mode)
      (funcall 'pc-selection-mode))))


; Move in other window
(defun scroll-other-up () (interactive) (scroll-other-window-down 1)) ; hehe :)
(defun scroll-other-down () (interactive) (scroll-other-window 1))

(defun match-paren (arg)
  "Go to the matching parenthesis if on parenthesis otherwise insert %."
  (interactive "p")
  (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1))
        ((looking-at "\\s\)") (forward-char 1) (backward-list 1))
        (t (self-insert-command (or arg 1)))))

(defun kde-start-c++-header ()
  "Start a new C++ header by inserting include guards ( see \
   header-protection function ), inserting a license statement \
   and putting (point) at the correct position"
  (interactive)
  (header-protection)
  (insert "\n")
  (beginning-of-buffer)
  (kde-license-insert "GNU GPL")
  (next-line 1)
  (kill-line)
  (end-of-buffer)
  (next-line -3)
  (insert "\n")
)

(defun kde-year-range-parse-years-string (string)
  "parses something like \"2000, 2008-2010\" into a list of the form \
   ((2008 . 2010)(2000 . 2000))"
  (let ((pos -1)
	(oldpos)
	(l (length string))
	(currange "")
	(startyear)
	(endyear)
	(ret)
	)
    (while (< pos l)
      (set oldpos (+ pos 1))
      (set pos (string-match "[,]" string (+ pos 1)))
      (unless pos (set pos l))
      (set currange (substring string oldpos pos))
      (string-match "[0-9]+" currange)
      (set startyear (string-to-int (match-string 0 currange)))
      (set endyear
	    (if (string-match "-" currange)
		(string-to-int (substring currange (match-end 0)))
	      startyear))
      (set ret (cons (cons startyear endyear) ret))
      )
    ret
    )
  )

(defun kde-year-range-contains-year (ranges year)
  "checks whether year is in ranges.. ( ranges is a list as \
   kde-year-range-parse-years-string returns.. "
  (let ((ret))
    (dolist (range ranges ret)
      (when (and (>= year (car range)) (<= year (cdr range)))
	(set ret t))
      )))

(defun kde-year-range-to-string (ranges)
  "converts ranges to a string.."
  (let ((ret ""))
    (dolist (range ranges)
      (set ret 
	    (concat
	     (int-to-string (car range))
	     (if (/= (cdr range) (car range))
		 (concat "-" (int-to-string (cdr range)))
	       "")
	     ", "
	     ret) 
	    )
      )
    ; remove extraneous ", "
    (set ret (substring ret 0 (- (length ret) 2)))
    )
  )

; merges adjacent year ranges into one..
(defun kde-year-range-cleanup (range)
  (let ((origrange range))
    (while (and range (cdr range))
      (let ((years (car range)) (nyears (cadr range)))
	(when (>= (+ (cdr nyears) 1) (car nyears))
	  (setcar range (cons (car nyears) (cdr years)))
	  (setcdr range (cddr range)))
	)
      (set range (cdr range))
      )
    origrange
    )
  )

; adds year to range..
(defun kde-year-range-add-year (range year)
  (while range
    (let ((years (car range)))
      (cond
       ((and (>= year (car years)) (<= year (cdr years))
	     ; year is already in the range..
	     (set range nil)))
       ((= year (+ (cdr years) 1))
	(setcdr years year)
	(set range nil))
       ((= year (- (car years) 1))
	(setcar years year)
	(set range nil))
       )
      )
    (set range (cdr range))
    )
  (kde-year-range-cleanup range)
  )

(defun kde-add-copyright () (interactive)
  "Tries to add your kde-full-name and kde-email to the Copyright \
   statements at the top of a file...  It tries to figure out \
   if it's already there, and if so, updates the line to include the \
   current year.. ( well, replaces it by a new one, anyway :) )"
  (let ((wascomment ""))
    (save-excursion
      (beginning-of-buffer)
      (if (re-search-forward (concat "Copyright ([Cc]) \\([0-9 ,-]*\\) " (regexp-quote kde-full-name)) nil t)
	  (progn
	    (beginning-of-line)
	    (let ((years (kde-year-range-cleanup (kde-year-range-parse-years-string (match-string 1))))
		  (new-copyright-string "Copyright (C) ")
		  (this-year (string-to-int (format-time-string "%Y"))))
	      (when (not (kde-year-range-contains-year years this-year))
		(kde-year-range-add-year years this-year))
	      (set new-copyright-string
		    (concat new-copyright-string (kde-year-range-to-string years)))
					; finish new-copyright-string 
	      (set new-copyright-string
		    (concat new-copyright-string "  " kde-full-name " <" kde-email ">"))
	      (beginning-of-line)
	      (re-search-forward "Copyright ([Cc])")
	      (beginning-of-line)
	      (set wascomment 
		    (buffer-substring (point)
				      (match-beginning 0)
				      ))
	      (kill-line nil)
	      (insert new-copyright-string)
	      )
	    )
	(beginning-of-buffer)
	(let ((first-copyright-str (re-search-forward "Copyright ([Cc])" nil t)))
	  (if first-copyright-str
	      (progn
		(goto-char first-copyright-str)
		(beginning-of-line)
		(set wascomment (buffer-substring (point) (match-beginning 0)))
		(forward-line 1)
		)
	    (goto-line 2))
	  )
	(beginning-of-line)
	(insert "Copyright (C) " (format-time-string "%Y") "  "
		kde-full-name " <" kde-email ">\n")
	(forward-line -1)
	)
      (end-of-line)
      (let ((end (point)))
	(beginning-of-line)
	(insert wascomment)
	)
      )
    )
  )

(defun kde-emacs-file-style-update ()
  "Updates the style header of this file"
  (interactive)
  (if (or (eq major-mode 'c++-mode)
	  (eq major-mode 'c-mode))
      (let ((startpoint) (endpoint)
	    (firstline) (strings)
	    (str) (m) (m2) (var) (value)
	    (final))
	(save-excursion
	  (beginning-of-buffer)
	  (set startpoint (point))
	  (set endpoint (point-at-eol)))
	(set firstline (buffer-substring startpoint endpoint))
	(if (string-match "-\*-\\([A-Za-z0-9\-\+\:\; ]+\\)-\*-" firstline)
	    (delete-region startpoint endpoint))
	(set final (concat "-*- "
			    "Mode: " mode-name "; "
			    "c-basic-offset: " (prin1-to-string c-basic-offset)  "; "
			    "indent-tabs-mode: " (prin1-to-string indent-tabs-mode)  "; "
			    "tab-width: " (prin1-to-string tab-width) "; "
			    "-*-"))
	(save-excursion
	  (beginning-of-buffer)
	  (insert final)
	  (comment-region (point-at-bol) (point-at-eol))
	  (newline)))))

; Helper for qt-open-header, for Qt 4. Opens a file if it says #include "../foo/bar.h",
; close it and open that file instead; recursively until finding a real file.
(defun qt-follow-includes (file)
  (let ((line "")
	(begin nil)
	(buffer nil))
    (find-file file)
    (goto-char 0)
    (if (looking-at "#include \"")
	(progn
	  (forward-char 10)
	  (set begin (point))
	  (re-search-forward "\"" nil t)
	  (backward-char 1)
	  (set file (buffer-substring begin (point)))
	  (set buffer (current-buffer))
	  (qt-follow-includes file)
	  (kill-buffer buffer)
	  )
      ; else: this is the right file, skip the comments and go to the class
      (progn
	(re-search-forward "^class" nil t)
	(beginning-of-line))
    )))

(defun qt-open-header ()
  "Open the Qt header file for the class under point"
  (interactive)
  (let* ((qtinc (concat (getenv "TQTDIR") "/include/"))
	(class (thing-at-point 'word))
	(f nil)
	(file nil)
	(files nil)
	)
    (save-excursion
      ; The Qt3 case: the includes are directly in $TQTDIR/include/, lowercased
      (set f (concat qtinc (downcase class) ".h" ))
      (if (file-readable-p f)
	  (set file f)
        ; For some Qt3/e classes: add _qws
	(set f (concat qtinc (downcase class) "_qws.h" ))
	(if (file-readable-p f)
	    (set file f)
        ; The Qt4 case: the includes are in $TQTDIR/include/QSomething/, in original case
	  (set files (directory-files qtinc t nil "dirsonly"))
	  (dolist (f files nil)
	    (if (file-readable-p (concat f "/" class) )
		(set file (concat f "/" class))))
	  ))
      (and file
	   (qt-follow-includes file))
      )
  ))

(provide 'kde-emacs-utils)